1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1998, 1999, 2000,
3 2001, 2004, 2005 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, int));
125 static void describe_vector
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
126 void (*) (Lisp_Object
, Lisp_Object
), int,
127 Lisp_Object
, Lisp_Object
, int *,
129 static void silly_event_symbol_error
P_ ((Lisp_Object
));
131 /* Keymap object support - constructors and predicates. */
133 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
134 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
135 CHARTABLE is a char-table that holds the bindings for all characters
136 without modifiers. All entries in it are initially nil, meaning
137 "command undefined". ALIST is an assoc-list which holds bindings for
138 function keys, mouse events, and any other things that appear in the
139 input stream. Initially, ALIST is nil.
141 The optional arg STRING supplies a menu name for the keymap
142 in case you use it as a menu with `x-popup-menu'. */)
148 tail
= Fcons (string
, Qnil
);
151 return Fcons (Qkeymap
,
152 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
155 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
156 doc
: /* Construct and return a new sparse keymap.
157 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
158 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
159 which binds the function key or mouse event SYMBOL to DEFINITION.
160 Initially the alist is nil.
162 The optional arg STRING supplies a menu name for the keymap
163 in case you use it as a menu with `x-popup-menu'. */)
168 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
169 return Fcons (Qkeymap
, Qnil
);
172 /* This function is used for installing the standard key bindings
173 at initialization time.
177 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
180 initial_define_key (keymap
, key
, defname
)
185 store_in_keymap (keymap
, make_number (key
), intern (defname
));
189 initial_define_lispy_key (keymap
, keyname
, defname
)
194 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
197 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
198 doc
: /* Return t if OBJECT is a keymap.
200 A keymap is a list (keymap . ALIST),
201 or a symbol whose function definition is itself a keymap.
202 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
203 a vector of densely packed bindings for small character codes
204 is also allowed as an element. */)
208 return (KEYMAPP (object
) ? Qt
: Qnil
);
211 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
212 doc
: /* Return the prompt-string of a keymap MAP.
213 If non-nil, the prompt is shown in the echo-area
214 when reading a key-sequence to be looked-up in this keymap. */)
218 map
= get_keymap (map
, 0, 0);
221 Lisp_Object tem
= XCAR (map
);
229 /* Check that OBJECT is a keymap (after dereferencing through any
230 symbols). If it is, return it.
232 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
233 is an autoload form, do the autoload and try again.
234 If AUTOLOAD is nonzero, callers must assume GC is possible.
236 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
237 is zero as well), return Qt.
239 ERROR controls how we respond if OBJECT isn't a keymap.
240 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
242 Note that most of the time, we don't want to pursue autoloads.
243 Functions like Faccessible_keymaps which scan entire keymap trees
244 shouldn't load every autoloaded keymap. I'm not sure about this,
245 but it seems to me that only read_key_sequence, Flookup_key, and
246 Fdefine_key should cause keymaps to be autoloaded.
248 This function can GC when AUTOLOAD is non-zero, because it calls
249 do_autoload which can GC. */
252 get_keymap (object
, error
, autoload
)
261 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
264 tem
= indirect_function (object
);
267 if (EQ (XCAR (tem
), Qkeymap
))
270 /* Should we do an autoload? Autoload forms for keymaps have
271 Qkeymap as their fifth element. */
272 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
)
277 tail
= Fnth (make_number (4), tem
);
278 if (EQ (tail
, Qkeymap
))
282 struct gcpro gcpro1
, gcpro2
;
284 GCPRO2 (tem
, object
);
285 do_autoload (tem
, object
);
298 wrong_type_argument (Qkeymapp
, object
);
302 /* Return the parent map of KEYMAP, or nil if it has none.
303 We assume that KEYMAP is a valid keymap. */
306 keymap_parent (keymap
, autoload
)
312 keymap
= get_keymap (keymap
, 1, autoload
);
314 /* Skip past the initial element `keymap'. */
315 list
= XCDR (keymap
);
316 for (; CONSP (list
); list
= XCDR (list
))
318 /* See if there is another `keymap'. */
323 return get_keymap (list
, 0, autoload
);
326 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
327 doc
: /* Return the parent keymap of KEYMAP. */)
331 return keymap_parent (keymap
, 1);
334 /* Check whether MAP is one of MAPS parents. */
336 keymap_memberp (map
, maps
)
337 Lisp_Object map
, maps
;
339 if (NILP (map
)) return 0;
340 while (KEYMAPP (maps
) && !EQ (map
, maps
))
341 maps
= keymap_parent (maps
, 0);
342 return (EQ (map
, maps
));
345 /* Set the parent keymap of MAP to PARENT. */
347 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
348 doc
: /* Modify KEYMAP to set its parent map to PARENT.
349 Return PARENT. PARENT should be nil or another keymap. */)
351 Lisp_Object keymap
, parent
;
353 Lisp_Object list
, prev
;
354 struct gcpro gcpro1
, gcpro2
;
357 /* Force a keymap flush for the next call to where-is.
358 Since this can be called from within where-is, we don't set where_is_cache
359 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
360 be changed during where-is, while where_is_cache_keymaps is only used at
361 the very beginning of where-is and can thus be changed here without any
363 This is a very minor correctness (rather than safety) issue. */
364 where_is_cache_keymaps
= Qt
;
366 GCPRO2 (keymap
, parent
);
367 keymap
= get_keymap (keymap
, 1, 1);
371 parent
= get_keymap (parent
, 1, 1);
373 /* Check for cycles. */
374 if (keymap_memberp (keymap
, parent
))
375 error ("Cyclic keymap inheritance");
378 /* Skip past the initial element `keymap'. */
383 /* If there is a parent keymap here, replace it.
384 If we came to the end, add the parent in PREV. */
385 if (!CONSP (list
) || KEYMAPP (list
))
387 /* If we already have the right parent, return now
388 so that we avoid the loops below. */
389 if (EQ (XCDR (prev
), parent
))
390 RETURN_UNGCPRO (parent
);
392 XSETCDR (prev
, parent
);
398 /* Scan through for submaps, and set their parents too. */
400 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
402 /* Stop the scan when we come to the parent. */
403 if (EQ (XCAR (list
), Qkeymap
))
406 /* If this element holds a prefix map, deal with it. */
407 if (CONSP (XCAR (list
))
408 && CONSP (XCDR (XCAR (list
))))
409 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
412 if (VECTORP (XCAR (list
)))
413 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
414 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
415 fix_submap_inheritance (keymap
, make_number (i
),
416 XVECTOR (XCAR (list
))->contents
[i
]);
418 if (CHAR_TABLE_P (XCAR (list
)))
420 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
), keymap
);
424 RETURN_UNGCPRO (parent
);
427 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
428 if EVENT is also a prefix in MAP's parent,
429 make sure that SUBMAP inherits that definition as its own parent. */
432 fix_submap_inheritance (map
, event
, submap
)
433 Lisp_Object map
, event
, submap
;
435 Lisp_Object map_parent
, parent_entry
;
437 /* SUBMAP is a cons that we found as a key binding.
438 Discard the other things found in a menu key binding. */
440 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
442 /* If it isn't a keymap now, there's no work to do. */
446 map_parent
= keymap_parent (map
, 0);
447 if (!NILP (map_parent
))
449 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
453 /* If MAP's parent has something other than a keymap,
454 our own submap shadows it completely. */
455 if (!CONSP (parent_entry
))
458 if (! EQ (parent_entry
, submap
))
460 Lisp_Object submap_parent
;
461 submap_parent
= submap
;
466 tem
= keymap_parent (submap_parent
, 0);
470 if (keymap_memberp (tem
, parent_entry
))
471 /* Fset_keymap_parent could create a cycle. */
478 Fset_keymap_parent (submap_parent
, parent_entry
);
482 /* Look up IDX in MAP. IDX may be any sort of event.
483 Note that this does only one level of lookup; IDX must be a single
484 event, not a sequence.
486 If T_OK is non-zero, bindings for Qt are treated as default
487 bindings; any key left unmentioned by other tables and bindings is
488 given the binding of Qt.
490 If T_OK is zero, bindings for Qt are not treated specially.
492 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
495 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
504 /* Qunbound in VAL means we have found no binding yet. */
507 /* If idx is a list (some sort of mouse click, perhaps?),
508 the index we want to use is the car of the list, which
509 ought to be a symbol. */
510 idx
= EVENT_HEAD (idx
);
512 /* If idx is a symbol, it might have modifiers, which need to
513 be put in the canonical order. */
515 idx
= reorder_modifiers (idx
);
516 else if (INTEGERP (idx
))
517 /* Clobber the high bits that can be present on a machine
518 with more than 24 bits of integer. */
519 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
521 /* Handle the special meta -> esc mapping. */
522 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
524 /* See if there is a meta-map. If there's none, there is
525 no binding for IDX, unless a default binding exists in MAP. */
527 Lisp_Object meta_map
;
529 /* A strange value in which Meta is set would cause
530 infinite recursion. Protect against that. */
531 if (XINT (meta_prefix_char
) & CHAR_META
)
532 meta_prefix_char
= make_number (27);
533 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
534 t_ok
, noinherit
, autoload
),
537 if (CONSP (meta_map
))
540 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
543 /* Set IDX to t, so that we only find a default binding. */
546 /* We know there is no binding. */
550 /* t_binding is where we put a default binding that applies,
551 to use in case we do not find a binding specifically
552 for this key sequence. */
555 Lisp_Object t_binding
= Qnil
;
556 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
558 GCPRO4 (map
, tail
, idx
, t_binding
);
560 /* If `t_ok' is 2, both `t' is accepted. */
563 for (tail
= XCDR (map
);
565 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
570 binding
= XCAR (tail
);
571 if (SYMBOLP (binding
))
573 /* If NOINHERIT, stop finding prefix definitions
574 after we pass a second occurrence of the `keymap' symbol. */
575 if (noinherit
&& EQ (binding
, Qkeymap
))
576 RETURN_UNGCPRO (Qnil
);
578 else if (CONSP (binding
))
580 Lisp_Object key
= XCAR (binding
);
583 val
= XCDR (binding
);
584 else if (t_ok
> 1 && EQ (key
, Qt
))
586 t_binding
= XCDR (binding
);
590 else if (VECTORP (binding
))
592 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
593 val
= AREF (binding
, XFASTINT (idx
));
595 else if (CHAR_TABLE_P (binding
))
597 /* Character codes with modifiers
598 are not included in a char-table.
599 All character codes without modifiers are included. */
600 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
602 val
= Faref (binding
, idx
);
603 /* `nil' has a special meaning for char-tables, so
604 we use something else to record an explicitly
611 /* If we found a binding, clean it up and return it. */
612 if (!EQ (val
, Qunbound
))
615 /* A Qt binding is just like an explicit nil binding
616 (i.e. it shadows any parent binding but not bindings in
617 keymaps of lower precedence). */
619 val
= get_keyelt (val
, autoload
);
621 fix_submap_inheritance (map
, idx
, val
);
622 RETURN_UNGCPRO (val
);
627 return get_keyelt (t_binding
, autoload
);
632 map_keymap_item (fun
, args
, key
, val
, data
)
633 map_keymap_function_t fun
;
634 Lisp_Object args
, key
, val
;
637 /* We should maybe try to detect bindings shadowed by previous
638 ones and things like that. */
641 (*fun
) (key
, val
, args
, data
);
645 map_keymap_char_table_item (args
, key
, val
)
646 Lisp_Object args
, key
, val
;
650 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
652 map_keymap_item (fun
, XCDR (args
), key
, val
,
653 XSAVE_VALUE (XCAR (args
))->pointer
);
657 /* Call FUN for every binding in MAP.
658 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
659 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
661 map_keymap (map
, fun
, args
, data
, autoload
)
662 map_keymap_function_t fun
;
663 Lisp_Object map
, args
;
667 struct gcpro gcpro1
, gcpro2
, gcpro3
;
670 GCPRO3 (map
, args
, tail
);
671 map
= get_keymap (map
, 1, autoload
);
672 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
673 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
676 Lisp_Object binding
= XCAR (tail
);
679 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
680 else if (VECTORP (binding
))
682 /* Loop over the char values represented in the vector. */
683 int len
= ASIZE (binding
);
685 for (c
= 0; c
< len
; c
++)
687 Lisp_Object character
;
688 XSETFASTINT (character
, c
);
689 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
692 else if (CHAR_TABLE_P (binding
))
694 map_char_table (map_keymap_char_table_item
, Qnil
, binding
,
695 Fcons (make_save_value (fun
, 0),
696 Fcons (make_save_value (data
, 0),
704 map_keymap_call (key
, val
, fun
, dummy
)
705 Lisp_Object key
, val
, fun
;
708 call2 (fun
, key
, val
);
711 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 3, 0,
712 doc
: /* Call FUNCTION for every binding in KEYMAP.
713 FUNCTION is called with two arguments: the event and its binding.
714 If KEYMAP has a parent, the parent's bindings are included as well.
715 This works recursively: if the parent has itself a parent, then the
716 grandparent's bindings are also included and so on.
717 usage: (map-keymap FUNCTION KEYMAP) */)
718 (function
, keymap
, sort_first
)
719 Lisp_Object function
, keymap
, sort_first
;
721 if (INTEGERP (function
))
722 /* We have to stop integers early since map_keymap gives them special
724 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
725 if (! NILP (sort_first
))
726 return call3 (intern ("map-keymap-internal"), function
, keymap
, Qt
);
728 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
732 /* Given OBJECT which was found in a slot in a keymap,
733 trace indirect definitions to get the actual definition of that slot.
734 An indirect definition is a list of the form
735 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
736 and INDEX is the object to look up in KEYMAP to yield the definition.
738 Also if OBJECT has a menu string as the first element,
739 remove that. Also remove a menu help string as second element.
741 If AUTOLOAD is nonzero, load autoloadable keymaps
742 that are referred to with indirection. */
745 get_keyelt (object
, autoload
)
751 if (!(CONSP (object
)))
752 /* This is really the value. */
755 /* If the keymap contents looks like (keymap ...) or (lambda ...)
757 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
760 /* If the keymap contents looks like (menu-item name . DEFN)
761 or (menu-item name DEFN ...) then use DEFN.
762 This is a new format menu item. */
763 else if (EQ (XCAR (object
), Qmenu_item
))
765 if (CONSP (XCDR (object
)))
769 object
= XCDR (XCDR (object
));
772 object
= XCAR (object
);
774 /* If there's a `:filter FILTER', apply FILTER to the
775 menu-item's definition to get the real definition to
777 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
778 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
781 filter
= XCAR (XCDR (tem
));
782 filter
= list2 (filter
, list2 (Qquote
, object
));
783 object
= menu_item_eval_property (filter
);
788 /* Invalid keymap. */
792 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
793 Keymap alist elements like (CHAR MENUSTRING . DEFN)
794 will be used by HierarKey menus. */
795 else if (STRINGP (XCAR (object
)))
797 object
= XCDR (object
);
798 /* Also remove a menu help string, if any,
799 following the menu item name. */
800 if (CONSP (object
) && STRINGP (XCAR (object
)))
801 object
= XCDR (object
);
802 /* Also remove the sublist that caches key equivalences, if any. */
803 if (CONSP (object
) && CONSP (XCAR (object
)))
806 carcar
= XCAR (XCAR (object
));
807 if (NILP (carcar
) || VECTORP (carcar
))
808 object
= XCDR (object
);
812 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
818 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
820 return (!CONSP (map
) ? object
/* Invalid keymap */
821 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
827 store_in_keymap (keymap
, idx
, def
)
829 register Lisp_Object idx
;
830 register Lisp_Object def
;
832 /* Flush any reverse-map cache. */
833 where_is_cache
= Qnil
;
834 where_is_cache_keymaps
= Qt
;
836 /* If we are preparing to dump, and DEF is a menu element
837 with a menu item indicator, copy it to ensure it is not pure. */
838 if (CONSP (def
) && PURE_P (def
)
839 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
840 def
= Fcons (XCAR (def
), XCDR (def
));
842 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
843 error ("attempt to define a key in a non-keymap");
845 /* If idx is a cons, and the car part is a character, idx must be of
846 the form (FROM-CHAR . TO-CHAR). */
847 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
848 CHECK_CHARACTER_CDR (idx
);
850 /* If idx is a list (some sort of mouse click, perhaps?),
851 the index we want to use is the car of the list, which
852 ought to be a symbol. */
853 idx
= EVENT_HEAD (idx
);
855 /* If idx is a symbol, it might have modifiers, which need to
856 be put in the canonical order. */
858 idx
= reorder_modifiers (idx
);
859 else if (INTEGERP (idx
))
860 /* Clobber the high bits that can be present on a machine
861 with more than 24 bits of integer. */
862 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
864 /* Scan the keymap for a binding of idx. */
868 /* The cons after which we should insert new bindings. If the
869 keymap has a table element, we record its position here, so new
870 bindings will go after it; this way, the table will stay
871 towards the front of the alist and character lookups in dense
872 keymaps will remain fast. Otherwise, this just points at the
873 front of the keymap. */
874 Lisp_Object insertion_point
;
876 insertion_point
= keymap
;
877 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
884 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
886 ASET (elt
, XFASTINT (idx
), def
);
889 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
891 int from
= XFASTINT (XCAR (idx
));
892 int to
= XFASTINT (XCDR (idx
));
894 if (to
>= ASIZE (elt
))
895 to
= ASIZE (elt
) - 1;
896 for (; from
<= to
; from
++)
897 ASET (elt
, from
, def
);
898 if (to
== XFASTINT (XCDR (idx
)))
899 /* We have defined all keys in IDX. */
902 insertion_point
= tail
;
904 else if (CHAR_TABLE_P (elt
))
906 /* Character codes with modifiers
907 are not included in a char-table.
908 All character codes without modifiers are included. */
909 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
912 /* `nil' has a special meaning for char-tables, so
913 we use something else to record an explicitly
915 NILP (def
) ? Qt
: def
);
918 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
920 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
923 insertion_point
= tail
;
925 else if (CONSP (elt
))
927 if (EQ (idx
, XCAR (elt
)))
932 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
934 int from
= XFASTINT (XCAR (idx
));
935 int to
= XFASTINT (XCDR (idx
));
937 if (from
<= XFASTINT (XCAR (elt
))
938 && to
>= XFASTINT (XCAR (elt
)))
946 else if (EQ (elt
, Qkeymap
))
947 /* If we find a 'keymap' symbol in the spine of KEYMAP,
948 then we must have found the start of a second keymap
949 being used as the tail of KEYMAP, and a binding for IDX
950 should be inserted before it. */
957 /* We have scanned the entire keymap, and not found a binding for
958 IDX. Let's add one. */
962 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
964 /* IDX specifies a range of characters, and not all of them
965 were handled yet, which means this keymap doesn't have a
966 char-table. So, we insert a char-table now. */
967 elt
= Fmake_char_table (Qkeymap
, Qnil
);
968 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
971 elt
= Fcons (idx
, def
);
972 XSETCDR (insertion_point
, Fcons (elt
, XCDR (insertion_point
)));
979 EXFUN (Fcopy_keymap
, 1);
982 copy_keymap_item (elt
)
985 Lisp_Object res
, tem
;
992 /* Is this a new format menu item. */
993 if (EQ (XCAR (tem
), Qmenu_item
))
995 /* Copy cell with menu-item marker. */
996 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1000 /* Copy cell with menu-item name. */
1001 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1007 /* Copy cell with binding and if the binding is a keymap,
1009 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1012 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1013 XSETCAR (elt
, Fcopy_keymap (tem
));
1015 if (CONSP (tem
) && CONSP (XCAR (tem
)))
1016 /* Delete cache for key equivalences. */
1017 XSETCDR (elt
, XCDR (tem
));
1022 /* It may be an old fomat menu item.
1023 Skip the optional menu string. */
1024 if (STRINGP (XCAR (tem
)))
1026 /* Copy the cell, since copy-alist didn't go this deep. */
1027 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1029 /* Also skip the optional menu help string. */
1030 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1032 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1036 /* There may also be a list that caches key equivalences.
1037 Just delete it for the new keymap. */
1039 && CONSP (XCAR (tem
))
1040 && (NILP (XCAR (XCAR (tem
)))
1041 || VECTORP (XCAR (XCAR (tem
)))))
1043 XSETCDR (elt
, XCDR (tem
));
1046 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1047 XSETCDR (elt
, Fcopy_keymap (tem
));
1049 else if (EQ (XCAR (tem
), Qkeymap
))
1050 res
= Fcopy_keymap (elt
);
1056 copy_keymap_1 (chartable
, idx
, elt
)
1057 Lisp_Object chartable
, idx
, elt
;
1059 Fset_char_table_range (chartable
, idx
, copy_keymap_item (elt
));
1062 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1063 doc
: /* Return a copy of the keymap KEYMAP.
1064 The copy starts out with the same definitions of KEYMAP,
1065 but changing either the copy or KEYMAP does not affect the other.
1066 Any key definitions that are subkeymaps are recursively copied.
1067 However, a key definition which is a symbol whose definition is a keymap
1072 register Lisp_Object copy
, tail
;
1073 keymap
= get_keymap (keymap
, 1, 0);
1074 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1075 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1077 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1079 Lisp_Object elt
= XCAR (keymap
);
1080 if (CHAR_TABLE_P (elt
))
1082 elt
= Fcopy_sequence (elt
);
1083 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
);
1085 else if (VECTORP (elt
))
1088 elt
= Fcopy_sequence (elt
);
1089 for (i
= 0; i
< ASIZE (elt
); i
++)
1090 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1092 else if (CONSP (elt
))
1093 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1094 XSETCDR (tail
, Fcons (elt
, Qnil
));
1096 keymap
= XCDR (keymap
);
1098 XSETCDR (tail
, keymap
);
1102 /* Simple Keymap mutators and accessors. */
1104 /* GC is possible in this function if it autoloads a keymap. */
1106 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1107 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1110 KEY is a string or a vector of symbols and characters meaning a
1111 sequence of keystrokes and events. Non-ASCII characters with codes
1112 above 127 (such as ISO Latin-1) can be included if you use a vector.
1113 Using [t] for KEY creates a default definition, which applies to any
1114 event type that has no other definition in this keymap.
1116 DEF is anything that can be a key's definition:
1117 nil (means key is undefined in this keymap),
1118 a command (a Lisp function suitable for interactive calling),
1119 a string (treated as a keyboard macro),
1120 a keymap (to define a prefix key),
1121 a symbol (when the key is looked up, the symbol will stand for its
1122 function definition, which should at that time be one of the above,
1123 or another symbol whose function definition is used, etc.),
1124 a cons (STRING . DEFN), meaning that DEFN is the definition
1125 (DEFN should be a valid definition in its own right),
1126 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1128 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1129 binding is altered. If there is no binding for KEY, the new pair
1130 binding KEY to DEF is added at the front of KEYMAP. */)
1137 register Lisp_Object c
;
1138 register Lisp_Object cmd
;
1142 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1144 GCPRO3 (keymap
, key
, def
);
1145 keymap
= get_keymap (keymap
, 1, 1);
1147 if (!VECTORP (key
) && !STRINGP (key
))
1148 key
= wrong_type_argument (Qarrayp
, key
);
1150 length
= XFASTINT (Flength (key
));
1152 RETURN_UNGCPRO (Qnil
);
1154 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1155 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1157 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1162 c
= Faref (key
, make_number (idx
));
1166 /* C may be a Lucid style event type list or a cons (FROM .
1167 TO) specifying a range of characters. */
1168 if (lucid_event_type_list_p (c
))
1169 c
= Fevent_convert_list (c
);
1170 else if (CHARACTERP (XCAR (c
)))
1171 CHECK_CHARACTER_CDR (c
);
1175 silly_event_symbol_error (c
);
1178 && (XINT (c
) & meta_bit
)
1181 c
= meta_prefix_char
;
1187 XSETINT (c
, XINT (c
) & ~meta_bit
);
1193 if (!INTEGERP (c
) && !SYMBOLP (c
)
1195 /* If C is a range, it must be a leaf. */
1196 || (INTEGERP (XCAR (c
)) && idx
!= length
)))
1197 error ("Key sequence contains invalid event");
1200 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1202 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1204 /* If this key is undefined, make it a prefix. */
1206 cmd
= define_as_prefix (keymap
, c
);
1208 keymap
= get_keymap (cmd
, 0, 1);
1209 if (!CONSP (keymap
))
1210 /* We must use Fkey_description rather than just passing key to
1211 error; key might be a vector, not a string. */
1212 error ("Key sequence %s uses invalid prefix characters",
1213 SDATA (Fkey_description (key
, Qnil
)));
1217 /* This function may GC (it calls Fkey_binding). */
1219 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1220 doc
: /* Return the remapping for command COMMAND in current keymaps.
1221 Returns nil if COMMAND is not remapped (or not a symbol). */)
1223 Lisp_Object command
;
1225 if (!SYMBOLP (command
))
1228 ASET (command_remapping_vector
, 1, command
);
1229 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1232 /* Value is number if KEY is too long; nil if valid but has no definition. */
1233 /* GC is possible in this function if it autoloads a keymap. */
1235 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1236 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1237 nil means undefined. See doc of `define-key' for kinds of definitions.
1239 A number as value means KEY is "too long";
1240 that is, characters or symbols in it except for the last one
1241 fail to be a valid sequence of prefix characters in KEYMAP.
1242 The number is how many characters at the front of KEY
1243 it takes to reach a non-prefix command.
1245 Normally, `lookup-key' ignores bindings for t, which act as default
1246 bindings, used when nothing else in the keymap applies; this makes it
1247 usable as a general function for probing keymaps. However, if the
1248 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1249 recognize the default bindings, just as `read-key-sequence' does. */)
1250 (keymap
, key
, accept_default
)
1253 Lisp_Object accept_default
;
1256 register Lisp_Object cmd
;
1257 register Lisp_Object c
;
1259 int t_ok
= !NILP (accept_default
);
1260 struct gcpro gcpro1
, gcpro2
;
1262 GCPRO2 (keymap
, key
);
1263 keymap
= get_keymap (keymap
, 1, 1);
1265 if (!VECTORP (key
) && !STRINGP (key
))
1266 key
= wrong_type_argument (Qarrayp
, key
);
1268 length
= XFASTINT (Flength (key
));
1270 RETURN_UNGCPRO (keymap
);
1275 c
= Faref (key
, make_number (idx
++));
1277 if (CONSP (c
) && lucid_event_type_list_p (c
))
1278 c
= Fevent_convert_list (c
);
1280 /* Turn the 8th bit of string chars into a meta modifier. */
1281 if (INTEGERP (c
) && XINT (c
) & 0x80 && STRINGP (key
))
1282 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1284 /* Allow string since binding for `menu-bar-select-buffer'
1285 includes the buffer name in the key sequence. */
1286 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1287 error ("Key sequence contains invalid event");
1289 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1291 RETURN_UNGCPRO (cmd
);
1293 keymap
= get_keymap (cmd
, 0, 1);
1294 if (!CONSP (keymap
))
1295 RETURN_UNGCPRO (make_number (idx
));
1301 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1302 Assume that currently it does not define C at all.
1303 Return the keymap. */
1306 define_as_prefix (keymap
, c
)
1307 Lisp_Object keymap
, c
;
1311 cmd
= Fmake_sparse_keymap (Qnil
);
1312 /* If this key is defined as a prefix in an inherited keymap,
1313 make it a prefix in this map, and make its definition
1314 inherit the other prefix definition. */
1315 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1316 store_in_keymap (keymap
, c
, cmd
);
1321 /* Append a key to the end of a key sequence. We always make a vector. */
1324 append_key (key_sequence
, key
)
1325 Lisp_Object key_sequence
, key
;
1327 Lisp_Object args
[2];
1329 args
[0] = key_sequence
;
1331 args
[1] = Fcons (key
, Qnil
);
1332 return Fvconcat (2, args
);
1335 /* Given a event type C which is a symbol,
1336 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1339 silly_event_symbol_error (c
)
1342 Lisp_Object parsed
, base
, name
, assoc
;
1345 parsed
= parse_modifiers (c
);
1346 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1347 base
= XCAR (parsed
);
1348 name
= Fsymbol_name (base
);
1349 /* This alist includes elements such as ("RET" . "\\r"). */
1350 assoc
= Fassoc (name
, exclude_keys
);
1354 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1356 Lisp_Object keystring
;
1357 if (modifiers
& alt_modifier
)
1358 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1359 if (modifiers
& ctrl_modifier
)
1360 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1361 if (modifiers
& hyper_modifier
)
1362 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1363 if (modifiers
& meta_modifier
)
1364 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1365 if (modifiers
& shift_modifier
)
1366 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1367 if (modifiers
& super_modifier
)
1368 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1371 c
= reorder_modifiers (c
);
1372 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1374 error ((modifiers
& ~meta_modifier
1375 ? "To bind the key %s, use [?%s], not [%s]"
1376 : "To bind the key %s, use \"%s\", not [%s]"),
1377 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1378 SDATA (SYMBOL_NAME (c
)));
1382 /* Global, local, and minor mode keymap stuff. */
1384 /* We can't put these variables inside current_minor_maps, since under
1385 some systems, static gets macro-defined to be the empty string.
1387 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1388 static int cmm_size
= 0;
1390 /* Error handler used in current_minor_maps. */
1392 current_minor_maps_error ()
1397 /* Store a pointer to an array of the keymaps of the currently active
1398 minor modes in *buf, and return the number of maps it contains.
1400 This function always returns a pointer to the same buffer, and may
1401 free or reallocate it, so if you want to keep it for a long time or
1402 hand it out to lisp code, copy it. This procedure will be called
1403 for every key sequence read, so the nice lispy approach (return a
1404 new assoclist, list, what have you) for each invocation would
1405 result in a lot of consing over time.
1407 If we used xrealloc/xmalloc and ran out of memory, they would throw
1408 back to the command loop, which would try to read a key sequence,
1409 which would call this function again, resulting in an infinite
1410 loop. Instead, we'll use realloc/malloc and silently truncate the
1411 list, let the key sequence be read, and hope some other piece of
1412 code signals the error. */
1414 current_minor_maps (modeptr
, mapptr
)
1415 Lisp_Object
**modeptr
, **mapptr
;
1418 int list_number
= 0;
1419 Lisp_Object alist
, assoc
, var
, val
;
1420 Lisp_Object emulation_alists
;
1421 Lisp_Object lists
[2];
1423 emulation_alists
= Vemulation_mode_map_alists
;
1424 lists
[0] = Vminor_mode_overriding_map_alist
;
1425 lists
[1] = Vminor_mode_map_alist
;
1427 for (list_number
= 0; list_number
< 2; list_number
++)
1429 if (CONSP (emulation_alists
))
1431 alist
= XCAR (emulation_alists
);
1432 emulation_alists
= XCDR (emulation_alists
);
1433 if (SYMBOLP (alist
))
1434 alist
= find_symbol_value (alist
);
1438 alist
= lists
[list_number
];
1440 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1441 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1442 && (var
= XCAR (assoc
), SYMBOLP (var
))
1443 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1448 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1449 and also an entry in Vminor_mode_map_alist,
1450 ignore the latter. */
1451 if (list_number
== 1)
1453 val
= assq_no_quit (var
, lists
[0]);
1460 int newsize
, allocsize
;
1461 Lisp_Object
*newmodes
, *newmaps
;
1463 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1464 allocsize
= newsize
* sizeof *newmodes
;
1466 /* Use malloc here. See the comment above this function.
1467 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1469 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1474 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1477 cmm_modes
= newmodes
;
1480 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1485 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1492 if (newmodes
== NULL
|| newmaps
== NULL
)
1497 /* Get the keymap definition--or nil if it is not defined. */
1498 temp
= internal_condition_case_1 (Findirect_function
,
1500 Qerror
, current_minor_maps_error
);
1504 cmm_maps
[i
] = temp
;
1510 if (modeptr
) *modeptr
= cmm_modes
;
1511 if (mapptr
) *mapptr
= cmm_maps
;
1515 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1517 doc
: /* Return a list of the currently active keymaps.
1518 OLP if non-nil indicates that we should obey `overriding-local-map' and
1519 `overriding-terminal-local-map'. */)
1523 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1527 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1528 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1529 /* The doc said that overriding-terminal-local-map should
1530 override overriding-local-map. The code used them both,
1531 but it seems clearer to use just one. rms, jan 2005. */
1532 else if (!NILP (Voverriding_local_map
))
1533 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1535 if (NILP (XCDR (keymaps
)))
1541 /* This usually returns the buffer's local map,
1542 but that can be overridden by a `local-map' property. */
1543 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1545 keymaps
= Fcons (local
, keymaps
);
1547 /* Now put all the minor mode keymaps on the list. */
1548 nmaps
= current_minor_maps (0, &maps
);
1550 for (i
= --nmaps
; i
>= 0; i
--)
1551 if (!NILP (maps
[i
]))
1552 keymaps
= Fcons (maps
[i
], keymaps
);
1554 /* This returns nil unless there is a `keymap' property. */
1555 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1557 keymaps
= Fcons (local
, keymaps
);
1563 /* GC is possible in this function if it autoloads a keymap. */
1565 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1566 doc
: /* Return the binding for command KEY in current keymaps.
1567 KEY is a string or vector, a sequence of keystrokes.
1568 The binding is probably a symbol with a function definition.
1570 Normally, `key-binding' ignores bindings for t, which act as default
1571 bindings, used when nothing else in the keymap applies; this makes it
1572 usable as a general function for probing keymaps. However, if the
1573 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1574 recognize the default bindings, just as `read-key-sequence' does.
1576 Like the normal command loop, `key-binding' will remap the command
1577 resulting from looking up KEY by looking up the command in the
1578 current keymaps. However, if the optional third argument NO-REMAP
1579 is non-nil, `key-binding' returns the unmapped command. */)
1580 (key
, accept_default
, no_remap
)
1581 Lisp_Object key
, accept_default
, no_remap
;
1583 Lisp_Object
*maps
, value
;
1585 struct gcpro gcpro1
;
1589 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1591 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1592 key
, accept_default
);
1593 if (! NILP (value
) && !INTEGERP (value
))
1596 else if (!NILP (Voverriding_local_map
))
1598 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1599 if (! NILP (value
) && !INTEGERP (value
))
1606 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1609 value
= Flookup_key (local
, key
, accept_default
);
1610 if (! NILP (value
) && !INTEGERP (value
))
1614 nmaps
= current_minor_maps (0, &maps
);
1615 /* Note that all these maps are GCPRO'd
1616 in the places where we found them. */
1618 for (i
= 0; i
< nmaps
; i
++)
1619 if (! NILP (maps
[i
]))
1621 value
= Flookup_key (maps
[i
], key
, accept_default
);
1622 if (! NILP (value
) && !INTEGERP (value
))
1626 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1629 value
= Flookup_key (local
, key
, accept_default
);
1630 if (! NILP (value
) && !INTEGERP (value
))
1635 value
= Flookup_key (current_global_map
, key
, accept_default
);
1639 if (NILP (value
) || INTEGERP (value
))
1642 /* If the result of the ordinary keymap lookup is an interactive
1643 command, look for a key binding (ie. remapping) for that command. */
1645 if (NILP (no_remap
) && SYMBOLP (value
))
1648 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1655 /* GC is possible in this function if it autoloads a keymap. */
1657 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1658 doc
: /* Return the binding for command KEYS in current local keymap only.
1659 KEYS is a string or vector, a sequence of keystrokes.
1660 The binding is probably a symbol with a function definition.
1662 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1663 bindings; see the description of `lookup-key' for more details about this. */)
1664 (keys
, accept_default
)
1665 Lisp_Object keys
, accept_default
;
1667 register Lisp_Object map
;
1668 map
= current_buffer
->keymap
;
1671 return Flookup_key (map
, keys
, accept_default
);
1674 /* GC is possible in this function if it autoloads a keymap. */
1676 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1677 doc
: /* Return the binding for command KEYS in current global keymap only.
1678 KEYS is a string or vector, a sequence of keystrokes.
1679 The binding is probably a symbol with a function definition.
1680 This function's return values are the same as those of `lookup-key'
1683 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1684 bindings; see the description of `lookup-key' for more details about this. */)
1685 (keys
, accept_default
)
1686 Lisp_Object keys
, accept_default
;
1688 return Flookup_key (current_global_map
, keys
, accept_default
);
1691 /* GC is possible in this function if it autoloads a keymap. */
1693 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1694 doc
: /* Find the visible minor mode bindings of KEY.
1695 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1696 the symbol which names the minor mode binding KEY, and BINDING is
1697 KEY's definition in that mode. In particular, if KEY has no
1698 minor-mode bindings, return nil. If the first binding is a
1699 non-prefix, all subsequent bindings will be omitted, since they would
1700 be ignored. Similarly, the list doesn't include non-prefix bindings
1701 that come after prefix bindings.
1703 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1704 bindings; see the description of `lookup-key' for more details about this. */)
1705 (key
, accept_default
)
1706 Lisp_Object key
, accept_default
;
1708 Lisp_Object
*modes
, *maps
;
1710 Lisp_Object binding
;
1712 struct gcpro gcpro1
, gcpro2
;
1714 nmaps
= current_minor_maps (&modes
, &maps
);
1715 /* Note that all these maps are GCPRO'd
1716 in the places where we found them. */
1719 GCPRO2 (key
, binding
);
1721 for (i
= j
= 0; i
< nmaps
; i
++)
1723 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1724 && !INTEGERP (binding
))
1726 if (KEYMAPP (binding
))
1727 maps
[j
++] = Fcons (modes
[i
], binding
);
1729 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1733 return Flist (j
, maps
);
1736 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1737 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1738 A new sparse keymap is stored as COMMAND's function definition and its value.
1739 If a second optional argument MAPVAR is given, the map is stored as
1740 its value instead of as COMMAND's value; but COMMAND is still defined
1742 The third optional argument NAME, if given, supplies a menu name
1743 string for the map. This is required to use the keymap as a menu.
1744 This function returns COMMAND. */)
1745 (command
, mapvar
, name
)
1746 Lisp_Object command
, mapvar
, name
;
1749 map
= Fmake_sparse_keymap (name
);
1750 Ffset (command
, map
);
1754 Fset (command
, map
);
1758 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1759 doc
: /* Select KEYMAP as the global keymap. */)
1763 keymap
= get_keymap (keymap
, 1, 1);
1764 current_global_map
= keymap
;
1769 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1770 doc
: /* Select KEYMAP as the local keymap.
1771 If KEYMAP is nil, that means no local keymap. */)
1776 keymap
= get_keymap (keymap
, 1, 1);
1778 current_buffer
->keymap
= keymap
;
1783 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1784 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1787 return current_buffer
->keymap
;
1790 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1791 doc
: /* Return the current global keymap. */)
1794 return current_global_map
;
1797 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1798 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1802 int nmaps
= current_minor_maps (0, &maps
);
1804 return Flist (nmaps
, maps
);
1807 /* Help functions for describing and documenting keymaps. */
1811 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1812 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1813 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1817 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1821 /* Look for and break cycles. */
1822 while (!NILP (tem
= Frassq (cmd
, maps
)))
1824 Lisp_Object prefix
= XCAR (tem
);
1825 int lim
= XINT (Flength (XCAR (tem
)));
1826 if (lim
<= XINT (Flength (thisseq
)))
1827 { /* This keymap was already seen with a smaller prefix. */
1829 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1830 Faref (thisseq
, make_number (i
))))
1833 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1836 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1837 but maybe `cmd' occurs again further down in `maps', so keep
1839 maps
= XCDR (Fmemq (tem
, maps
));
1842 /* If the last key in thisseq is meta-prefix-char,
1843 turn it into a meta-ized keystroke. We know
1844 that the event we're about to append is an
1845 ascii keystroke since we're processing a
1849 int meta_bit
= meta_modifier
;
1850 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1851 tem
= Fcopy_sequence (thisseq
);
1853 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1855 /* This new sequence is the same length as
1856 thisseq, so stick it in the list right
1859 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1863 tem
= append_key (thisseq
, key
);
1864 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1869 accessible_keymaps_char_table (args
, index
, cmd
)
1870 Lisp_Object args
, index
, cmd
;
1872 accessible_keymaps_1 (index
, cmd
,
1876 XINT (XCDR (XCAR (args
))));
1879 /* This function cannot GC. */
1881 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1883 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1884 Returns a list of elements of the form (KEYS . MAP), where the sequence
1885 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1886 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1887 An optional argument PREFIX, if non-nil, should be a key sequence;
1888 then the value includes only maps for prefixes that start with PREFIX. */)
1890 Lisp_Object keymap
, prefix
;
1892 Lisp_Object maps
, tail
;
1895 /* no need for gcpro because we don't autoload any keymaps. */
1898 prefixlen
= XINT (Flength (prefix
));
1902 /* If a prefix was specified, start with the keymap (if any) for
1903 that prefix, so we don't waste time considering other prefixes. */
1905 tem
= Flookup_key (keymap
, prefix
, Qt
);
1906 /* Flookup_key may give us nil, or a number,
1907 if the prefix is not defined in this particular map.
1908 It might even give us a list that isn't a keymap. */
1909 tem
= get_keymap (tem
, 0, 0);
1912 /* Convert PREFIX to a vector now, so that later on
1913 we don't have to deal with the possibility of a string. */
1914 if (STRINGP (prefix
))
1919 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1920 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1924 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1925 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1926 c
^= 0200 | meta_modifier
;
1927 ASET (copy
, i_before
, make_number (c
));
1931 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1937 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1938 get_keymap (keymap
, 1, 0)),
1941 /* For each map in the list maps,
1942 look at any other maps it points to,
1943 and stick them at the end if they are not already in the list.
1945 This is a breadth-first traversal, where tail is the queue of
1946 nodes, and maps accumulates a list of all nodes visited. */
1948 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1950 register Lisp_Object thisseq
, thismap
;
1952 /* Does the current sequence end in the meta-prefix-char? */
1955 thisseq
= Fcar (Fcar (tail
));
1956 thismap
= Fcdr (Fcar (tail
));
1957 last
= make_number (XINT (Flength (thisseq
)) - 1);
1958 is_metized
= (XINT (last
) >= 0
1959 /* Don't metize the last char of PREFIX. */
1960 && XINT (last
) >= prefixlen
1961 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1963 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1967 elt
= XCAR (thismap
);
1971 if (CHAR_TABLE_P (elt
))
1973 map_char_table (accessible_keymaps_char_table
, Qnil
,
1974 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1975 Fcons (tail
, thisseq
)));
1977 else if (VECTORP (elt
))
1981 /* Vector keymap. Scan all the elements. */
1982 for (i
= 0; i
< ASIZE (elt
); i
++)
1983 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1984 maps
, tail
, thisseq
, is_metized
);
1987 else if (CONSP (elt
))
1988 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1989 maps
, tail
, thisseq
,
1990 is_metized
&& INTEGERP (XCAR (elt
)));
1998 Lisp_Object Qsingle_key_description
, Qkey_description
;
2000 /* This function cannot GC. */
2002 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
2003 doc
: /* Return a pretty description of key-sequence KEYS.
2004 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2005 Control characters turn into "C-foo" sequences, meta into "M-foo",
2006 spaces are put between sequence elements, etc. */)
2008 Lisp_Object keys
, prefix
;
2013 int size
= XINT (Flength (keys
));
2015 Lisp_Object sep
= build_string (" ");
2020 size
+= XINT (Flength (prefix
));
2022 /* This has one extra element at the end that we don't pass to Fconcat. */
2023 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
2025 /* In effect, this computes
2026 (mapconcat 'single-key-description keys " ")
2027 but we shouldn't use mapconcat because it can do GC. */
2031 list
= prefix
, prefix
= Qnil
;
2032 else if (!NILP (keys
))
2033 list
= keys
, keys
= Qnil
;
2038 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2042 return empty_string
;
2043 return Fconcat (len
- 1, args
);
2047 size
= SCHARS (list
);
2048 else if (VECTORP (list
))
2049 size
= XVECTOR (list
)->size
;
2050 else if (CONSP (list
))
2051 size
= XINT (Flength (list
));
2053 wrong_type_argument (Qarrayp
, list
);
2062 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2063 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2064 c
^= 0200 | meta_modifier
;
2065 XSETFASTINT (key
, c
);
2067 else if (VECTORP (list
))
2069 key
= AREF (list
, i
++);
2081 || EQ (key
, meta_prefix_char
)
2082 || (XINT (key
) & meta_modifier
))
2084 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2086 if (EQ (key
, meta_prefix_char
))
2090 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2093 else if (EQ (key
, meta_prefix_char
))
2098 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2106 push_key_description (c
, p
, force_multibyte
)
2107 register unsigned int c
;
2109 int force_multibyte
;
2113 /* Clear all the meaningless bits above the meta bit. */
2114 c
&= meta_modifier
| ~ - meta_modifier
;
2115 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2116 | meta_modifier
| shift_modifier
| super_modifier
);
2118 if (c
& alt_modifier
)
2124 if ((c
& ctrl_modifier
) != 0
2125 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2129 c
&= ~ctrl_modifier
;
2131 if (c
& hyper_modifier
)
2135 c
-= hyper_modifier
;
2137 if (c
& meta_modifier
)
2143 if (c
& shift_modifier
)
2147 c
-= shift_modifier
;
2149 if (c
& super_modifier
)
2153 c
-= super_modifier
;
2169 else if (c
== Ctl ('M'))
2177 /* `C-' already added above. */
2178 if (c
> 0 && c
<= Ctl ('Z'))
2197 || (NILP (current_buffer
->enable_multibyte_characters
)
2198 && SINGLE_BYTE_CHAR_P (c
)
2199 && !force_multibyte
))
2203 else if (CHARACTERP (make_number (c
)))
2205 if (NILP (current_buffer
->enable_multibyte_characters
)
2206 && ! force_multibyte
)
2207 *p
++ = multibyte_char_to_unibyte (c
, Qnil
);
2209 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2215 /* The biggest character code uses 22 bits. */
2216 for (bit_offset
= 21; bit_offset
>= 0; bit_offset
-= 3)
2218 if (c
>= (1 << bit_offset
))
2219 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2226 /* This function cannot GC. */
2228 DEFUN ("single-key-description", Fsingle_key_description
,
2229 Ssingle_key_description
, 1, 2, 0,
2230 doc
: /* Return a pretty description of command character KEY.
2231 Control characters turn into C-whatever, etc.
2232 Optional argument NO-ANGLES non-nil means don't put angle brackets
2233 around function keys and event symbols. */)
2235 Lisp_Object key
, no_angles
;
2237 if (CONSP (key
) && lucid_event_type_list_p (key
))
2238 key
= Fevent_convert_list (key
);
2240 key
= EVENT_HEAD (key
);
2242 if (INTEGERP (key
)) /* Normal character */
2244 char tem
[KEY_DESCRIPTION_SIZE
];
2246 *push_key_description (XUINT (key
), tem
, 1) = 0;
2247 return build_string (tem
);
2249 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2251 if (NILP (no_angles
))
2254 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2255 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2256 return build_string (buffer
);
2259 return Fsymbol_name (key
);
2261 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2262 return Fcopy_sequence (key
);
2264 error ("KEY must be an integer, cons, symbol, or string");
2269 push_text_char_description (c
, p
)
2270 register unsigned int c
;
2282 *p
++ = c
+ 64; /* 'A' - 1 */
2294 /* This function cannot GC. */
2296 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2297 doc
: /* Return a pretty description of file-character CHARACTER.
2298 Control characters turn into "^char", etc. This differs from
2299 `single-key-description' which turns them into "C-char".
2300 Also, this function recognizes the 2**7 bit as the Meta character,
2301 whereas `single-key-description' uses the 2**27 bit for Meta.
2302 See Info node `(elisp)Describing Characters' for examples. */)
2304 Lisp_Object character
;
2306 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2307 unsigned char str
[6];
2310 CHECK_NUMBER (character
);
2312 c
= XINT (character
);
2313 if (!ASCII_CHAR_P (c
))
2315 int len
= CHAR_STRING (c
, str
);
2317 return make_multibyte_string (str
, 1, len
);
2320 *push_text_char_description (c
& 0377, str
) = 0;
2322 return build_string (str
);
2325 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2328 ascii_sequence_p (seq
)
2332 int len
= XINT (Flength (seq
));
2334 for (i
= 0; i
< len
; i
++)
2336 Lisp_Object ii
, elt
;
2338 XSETFASTINT (ii
, i
);
2339 elt
= Faref (seq
, ii
);
2342 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2350 /* where-is - finding a command in a set of keymaps. */
2352 static Lisp_Object
where_is_internal ();
2353 static Lisp_Object
where_is_internal_1 ();
2354 static void where_is_internal_2 ();
2356 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2357 Returns the first non-nil binding found in any of those maps. */
2360 shadow_lookup (shadow
, key
, flag
)
2361 Lisp_Object shadow
, key
, flag
;
2363 Lisp_Object tail
, value
;
2365 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2367 value
= Flookup_key (XCAR (tail
), key
, flag
);
2368 if (!NILP (value
) && !NATNUMP (value
))
2374 static Lisp_Object Vmouse_events
;
2376 /* This function can GC if Flookup_key autoloads any keymaps. */
2379 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2380 Lisp_Object definition
, keymaps
;
2381 Lisp_Object firstonly
, noindirect
, no_remap
;
2383 Lisp_Object maps
= Qnil
;
2384 Lisp_Object found
, sequences
;
2385 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2386 /* 1 means ignore all menu bindings entirely. */
2387 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2389 /* If this command is remapped, then it has no key bindings
2391 if (NILP (no_remap
) && SYMBOLP (definition
))
2394 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2399 while (CONSP (found
))
2403 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2404 found
= XCDR (found
);
2407 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2411 for (; !NILP (maps
); maps
= Fcdr (maps
))
2413 /* Key sequence to reach map, and the map that it reaches */
2414 register Lisp_Object
this, map
, tem
;
2416 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2417 [M-CHAR] sequences, check if last character of the sequence
2418 is the meta-prefix char. */
2422 this = Fcar (Fcar (maps
));
2423 map
= Fcdr (Fcar (maps
));
2424 last
= make_number (XINT (Flength (this)) - 1);
2425 last_is_meta
= (XINT (last
) >= 0
2426 && EQ (Faref (this, last
), meta_prefix_char
));
2428 /* if (nomenus && !ascii_sequence_p (this)) */
2429 if (nomenus
&& XINT (last
) >= 0
2430 && SYMBOLP (tem
= Faref (this, make_number (0)))
2431 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2432 /* If no menu entries should be returned, skip over the
2433 keymaps bound to `menu-bar' and `tool-bar' and other
2434 non-ascii prefixes like `C-down-mouse-2'. */
2441 /* Because the code we want to run on each binding is rather
2442 large, we don't want to have two separate loop bodies for
2443 sparse keymap bindings and tables; we want to iterate one
2444 loop body over both keymap and vector bindings.
2446 For this reason, if Fcar (map) is a vector, we don't
2447 advance map to the next element until i indicates that we
2448 have finished off the vector. */
2449 Lisp_Object elt
, key
, binding
;
2457 /* Set key and binding to the current key and binding, and
2458 advance map and i to the next binding. */
2461 Lisp_Object sequence
;
2463 /* In a vector, look at each element. */
2464 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2466 binding
= AREF (elt
, i
);
2467 XSETFASTINT (key
, i
);
2468 sequence
= where_is_internal_1 (binding
, key
, definition
,
2470 last
, nomenus
, last_is_meta
);
2471 if (!NILP (sequence
))
2472 sequences
= Fcons (sequence
, sequences
);
2475 else if (CHAR_TABLE_P (elt
))
2479 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2480 Qnil
), /* Result accumulator. */
2481 Fcons (Fcons (this, last
),
2482 Fcons (make_number (nomenus
),
2483 make_number (last_is_meta
))));
2484 map_char_table (where_is_internal_2
, Qnil
, elt
, args
);
2485 sequences
= XCDR (XCAR (args
));
2487 else if (CONSP (elt
))
2489 Lisp_Object sequence
;
2492 binding
= XCDR (elt
);
2494 sequence
= where_is_internal_1 (binding
, key
, definition
,
2496 last
, nomenus
, last_is_meta
);
2497 if (!NILP (sequence
))
2498 sequences
= Fcons (sequence
, sequences
);
2502 while (!NILP (sequences
))
2504 Lisp_Object sequence
, remapped
, function
;
2506 sequence
= XCAR (sequences
);
2507 sequences
= XCDR (sequences
);
2509 /* If the current sequence is a command remapping with
2510 format [remap COMMAND], find the key sequences
2511 which run COMMAND, and use those sequences instead. */
2514 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2515 && EQ (AREF (sequence
, 0), Qremap
)
2516 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2518 Lisp_Object remapped1
;
2520 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2521 if (CONSP (remapped1
))
2523 /* Verify that this key binding actually maps to the
2524 remapped command (see below). */
2525 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2527 sequence
= XCAR (remapped1
);
2528 remapped
= XCDR (remapped1
);
2529 goto record_sequence
;
2533 /* Verify that this key binding is not shadowed by another
2534 binding for the same key, before we say it exists.
2536 Mechanism: look for local definition of this key and if
2537 it is defined and does not match what we found then
2540 Either nil or number as value from Flookup_key
2542 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2546 /* It is a true unshadowed match. Record it, unless it's already
2547 been seen (as could happen when inheriting keymaps). */
2548 if (NILP (Fmember (sequence
, found
)))
2549 found
= Fcons (sequence
, found
);
2551 /* If firstonly is Qnon_ascii, then we can return the first
2552 binding we find. If firstonly is not Qnon_ascii but not
2553 nil, then we should return the first ascii-only binding
2555 if (EQ (firstonly
, Qnon_ascii
))
2556 RETURN_UNGCPRO (sequence
);
2557 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2558 RETURN_UNGCPRO (sequence
);
2560 if (CONSP (remapped
))
2562 sequence
= XCAR (remapped
);
2563 remapped
= XCDR (remapped
);
2564 goto record_sequence
;
2572 found
= Fnreverse (found
);
2574 /* firstonly may have been t, but we may have gone all the way through
2575 the keymaps without finding an all-ASCII key sequence. So just
2576 return the best we could find. */
2577 if (!NILP (firstonly
))
2578 return Fcar (found
);
2583 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2584 doc
: /* Return list of keys that invoke DEFINITION.
2585 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2586 If KEYMAP is nil, search all the currently active keymaps.
2587 If KEYMAP is a list of keymaps, search only those keymaps.
2589 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2590 rather than a list of all possible key sequences.
2591 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2592 no matter what it is.
2593 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2594 \(or their meta variants) and entirely reject menu bindings.
2596 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2597 to other keymaps or slots. This makes it possible to search for an
2598 indirect definition itself.
2600 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2601 that invoke a command which is remapped to DEFINITION, but include the
2602 remapped command in the returned list. */)
2603 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2604 Lisp_Object definition
, keymap
;
2605 Lisp_Object firstonly
, noindirect
, no_remap
;
2607 Lisp_Object sequences
, keymaps
;
2608 /* 1 means ignore all menu bindings entirely. */
2609 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2612 /* Find the relevant keymaps. */
2613 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2615 else if (!NILP (keymap
))
2616 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2618 keymaps
= Fcurrent_active_maps (Qnil
);
2620 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2621 We don't really need to check `keymap'. */
2622 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2626 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2628 /* Check heuristic-consistency of the cache. */
2629 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2630 where_is_cache
= Qnil
;
2632 if (NILP (where_is_cache
))
2634 /* We need to create the cache. */
2635 Lisp_Object args
[2];
2636 where_is_cache
= Fmake_hash_table (0, args
);
2637 where_is_cache_keymaps
= Qt
;
2639 /* Fill in the cache. */
2640 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2641 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2644 where_is_cache_keymaps
= keymaps
;
2647 /* We want to process definitions from the last to the first.
2648 Instead of consing, copy definitions to a vector and step
2649 over that vector. */
2650 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2651 n
= XINT (Flength (sequences
));
2652 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2653 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2654 defns
[i
++] = XCAR (sequences
);
2656 /* Verify that the key bindings are not shadowed. Note that
2657 the following can GC. */
2658 GCPRO2 (definition
, keymaps
);
2661 for (i
= n
- 1; i
>= 0; --i
)
2662 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2664 if (ascii_sequence_p (defns
[i
]))
2670 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2675 /* Kill the cache so that where_is_internal_1 doesn't think
2676 we're filling it up. */
2677 where_is_cache
= Qnil
;
2678 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2684 /* This is the function that Fwhere_is_internal calls using map_char_table.
2686 (((DEFINITION . NOINDIRECT) . RESULT)
2688 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2689 Since map_char_table doesn't really use the return value from this function,
2690 we the result append to RESULT, the slot in ARGS.
2692 KEY may be a cons (FROM . TO) where both FROM and TO are integers
2693 (i.e. character events).
2695 This function can GC because it calls where_is_internal_1 which can
2699 where_is_internal_2 (args
, key
, binding
)
2700 Lisp_Object args
, key
, binding
;
2702 Lisp_Object definition
, noindirect
, this, last
;
2703 Lisp_Object result
, sequence
;
2704 int nomenus
, last_is_meta
;
2705 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2707 GCPRO3 (args
, key
, binding
);
2708 definition
= XCAR (XCAR (XCAR (args
)));
2709 noindirect
= XCDR (XCAR (XCAR (args
)));
2710 this = XCAR (XCAR (XCDR (args
)));
2711 last
= XCDR (XCAR (XCDR (args
)));
2712 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2713 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2716 if (CONSP (key
) && INTEGERP (XCAR (key
)) && INTEGERP (XCDR (key
)))
2718 /* Try all ASCII characters. Try also non-ASCII characters but
2719 only the first and last one because trying all of them is
2720 extremely memory and time consuming.
2722 Fixme: Perhaps it should be allowed to store a cons directly
2723 in RESULT. -- handa@m17n.org */
2724 int from
= XINT (XCAR (key
)), to
= XINT (XCDR (key
));
2727 for (; from
<= to
; to
--)
2729 k
= make_number (to
);
2730 sequence
= where_is_internal_1 (binding
, k
, definition
, noindirect
,
2731 this, last
, nomenus
, last_is_meta
);
2732 if (!NILP (sequence
))
2733 result
= Fcons (sequence
, result
);
2740 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2741 this, last
, nomenus
, last_is_meta
);
2742 if (!NILP (sequence
))
2743 result
= Fcons (sequence
, Qnil
);
2746 if (! NILP (result
))
2747 nconc2 (XCAR (args
), result
);
2753 /* This function cannot GC. */
2756 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2757 nomenus
, last_is_meta
)
2758 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2759 int nomenus
, last_is_meta
;
2761 Lisp_Object sequence
;
2763 /* Search through indirections unless that's not wanted. */
2764 if (NILP (noindirect
))
2765 binding
= get_keyelt (binding
, 0);
2767 /* End this iteration if this element does not match
2770 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2771 || EQ (binding
, definition
)
2772 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2773 /* Doesn't match. */
2776 /* We have found a match. Construct the key sequence where we found it. */
2777 if (INTEGERP (key
) && last_is_meta
)
2779 sequence
= Fcopy_sequence (this);
2780 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2783 sequence
= append_key (this, key
);
2785 if (!NILP (where_is_cache
))
2787 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2788 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2795 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2797 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2798 doc
: /* Insert the list of all defined keys and their definitions.
2799 The list is inserted in the current buffer, while the bindings are
2800 looked up in BUFFER.
2801 The optional argument PREFIX, if non-nil, should be a key sequence;
2802 then we display only bindings that start with that prefix.
2803 The optional argument MENUS, if non-nil, says to mention menu bindings.
2804 \(Ordinarily these are omitted from the output.) */)
2805 (buffer
, prefix
, menus
)
2806 Lisp_Object buffer
, prefix
, menus
;
2808 Lisp_Object outbuf
, shadow
;
2809 int nomenu
= NILP (menus
);
2810 register Lisp_Object start1
;
2811 struct gcpro gcpro1
;
2813 char *alternate_heading
2815 Keyboard translations:\n\n\
2816 You type Translation\n\
2817 -------- -----------\n";
2822 outbuf
= Fcurrent_buffer ();
2824 /* Report on alternates for keys. */
2825 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2828 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2829 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2831 for (c
= 0; c
< translate_len
; c
++)
2832 if (translate
[c
] != c
)
2834 char buf
[KEY_DESCRIPTION_SIZE
];
2837 if (alternate_heading
)
2839 insert_string (alternate_heading
);
2840 alternate_heading
= 0;
2843 bufend
= push_key_description (translate
[c
], buf
, 1);
2844 insert (buf
, bufend
- buf
);
2845 Findent_to (make_number (16), make_number (1));
2846 bufend
= push_key_description (c
, buf
, 1);
2847 insert (buf
, bufend
- buf
);
2855 if (!NILP (Vkey_translation_map
))
2856 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2857 "Key translations", nomenu
, 1, 0, 0);
2860 /* Print the (major mode) local map. */
2862 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2863 start1
= current_kboard
->Voverriding_terminal_local_map
;
2864 else if (!NILP (Voverriding_local_map
))
2865 start1
= Voverriding_local_map
;
2869 describe_map_tree (start1
, 1, shadow
, prefix
,
2870 "\f\nOverriding Bindings", nomenu
, 0, 0, 0);
2871 shadow
= Fcons (start1
, shadow
);
2875 /* Print the minor mode and major mode keymaps. */
2877 Lisp_Object
*modes
, *maps
;
2879 /* Temporarily switch to `buffer', so that we can get that buffer's
2880 minor modes correctly. */
2881 Fset_buffer (buffer
);
2883 nmaps
= current_minor_maps (&modes
, &maps
);
2884 Fset_buffer (outbuf
);
2886 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2887 XBUFFER (buffer
), Qkeymap
);
2890 describe_map_tree (start1
, 1, shadow
, prefix
,
2891 "\f\n`keymap' Property Bindings", nomenu
,
2893 shadow
= Fcons (start1
, shadow
);
2896 /* Print the minor mode maps. */
2897 for (i
= 0; i
< nmaps
; i
++)
2899 /* The title for a minor mode keymap
2900 is constructed at run time.
2901 We let describe_map_tree do the actual insertion
2902 because it takes care of other features when doing so. */
2905 if (!SYMBOLP (modes
[i
]))
2908 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2912 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2913 SCHARS (SYMBOL_NAME (modes
[i
])));
2914 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2916 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2917 p
+= sizeof (" Minor Mode Bindings") - 1;
2920 describe_map_tree (maps
[i
], 1, shadow
, prefix
,
2921 title
, nomenu
, 0, 0, 0);
2922 shadow
= Fcons (maps
[i
], shadow
);
2925 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2926 XBUFFER (buffer
), Qlocal_map
);
2929 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2930 describe_map_tree (start1
, 1, shadow
, prefix
,
2931 "\f\nMajor Mode Bindings", nomenu
, 0, 0, 0);
2933 describe_map_tree (start1
, 1, shadow
, prefix
,
2934 "\f\n`local-map' Property Bindings",
2937 shadow
= Fcons (start1
, shadow
);
2941 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2942 "\f\nGlobal Bindings", nomenu
, 0, 1, 0);
2944 /* Print the function-key-map translations under this prefix. */
2945 if (!NILP (Vfunction_key_map
))
2946 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2947 "\f\nFunction key map translations", nomenu
, 1, 0, 0);
2953 /* Insert a description of the key bindings in STARTMAP,
2954 followed by those of all maps reachable through STARTMAP.
2955 If PARTIAL is nonzero, omit certain "uninteresting" commands
2956 (such as `undefined').
2957 If SHADOW is non-nil, it is a list of maps;
2958 don't mention keys which would be shadowed by any of them.
2959 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2960 TITLE, if not 0, is a string to insert at the beginning.
2961 TITLE should not end with a colon or a newline; we supply that.
2962 If NOMENU is not 0, then omit menu-bar commands.
2964 If TRANSL is nonzero, the definitions are actually key translations
2965 so print strings and vectors differently.
2967 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2970 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
2971 don't omit it; instead, mention it but say it is shadowed. */
2974 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2975 always_title
, mention_shadow
)
2976 Lisp_Object startmap
, shadow
, prefix
;
2984 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2985 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2992 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2995 GCPRO3 (maps
, seen
, sub_shadows
);
3001 /* Delete from MAPS each element that is for the menu bar. */
3002 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
3004 Lisp_Object elt
, prefix
, tem
;
3007 prefix
= Fcar (elt
);
3008 if (XVECTOR (prefix
)->size
>= 1)
3010 tem
= Faref (prefix
, make_number (0));
3011 if (EQ (tem
, Qmenu_bar
))
3012 maps
= Fdelq (elt
, maps
);
3017 if (!NILP (maps
) || always_title
)
3021 insert_string (title
);
3024 insert_string (" Starting With ");
3025 insert1 (Fkey_description (prefix
, Qnil
));
3027 insert_string (":\n");
3029 insert_string (key_heading
);
3033 for (; !NILP (maps
); maps
= Fcdr (maps
))
3035 register Lisp_Object elt
, prefix
, tail
;
3038 prefix
= Fcar (elt
);
3042 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
3046 shmap
= XCAR (tail
);
3048 /* If the sequence by which we reach this keymap is zero-length,
3049 then the shadow map for this keymap is just SHADOW. */
3050 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
3051 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3053 /* If the sequence by which we reach this keymap actually has
3054 some elements, then the sequence's definition in SHADOW is
3055 what we should use. */
3058 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3059 if (INTEGERP (shmap
))
3063 /* If shmap is not nil and not a keymap,
3064 it completely shadows this map, so don't
3065 describe this map at all. */
3066 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3070 sub_shadows
= Fcons (shmap
, sub_shadows
);
3073 /* Maps we have already listed in this loop shadow this map. */
3074 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3077 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3079 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3082 describe_map (Fcdr (elt
), prefix
,
3083 transl
? describe_translation
: describe_command
,
3084 partial
, sub_shadows
, &seen
, nomenu
, mention_shadow
);
3090 insert_string ("\n");
3095 static int previous_description_column
;
3098 describe_command (definition
, args
)
3099 Lisp_Object definition
, args
;
3101 register Lisp_Object tem1
;
3102 int column
= (int) current_column (); /* iftc */
3103 int description_column
;
3105 /* If column 16 is no good, go to col 32;
3106 but don't push beyond that--go to next line instead. */
3110 description_column
= 32;
3112 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3113 description_column
= 32;
3115 description_column
= 16;
3117 Findent_to (make_number (description_column
), make_number (1));
3118 previous_description_column
= description_column
;
3120 if (SYMBOLP (definition
))
3122 tem1
= SYMBOL_NAME (definition
);
3124 insert_string ("\n");
3126 else if (STRINGP (definition
) || VECTORP (definition
))
3127 insert_string ("Keyboard Macro\n");
3128 else if (KEYMAPP (definition
))
3129 insert_string ("Prefix Command\n");
3131 insert_string ("??\n");
3135 describe_translation (definition
, args
)
3136 Lisp_Object definition
, args
;
3138 register Lisp_Object tem1
;
3140 Findent_to (make_number (16), make_number (1));
3142 if (SYMBOLP (definition
))
3144 tem1
= SYMBOL_NAME (definition
);
3146 insert_string ("\n");
3148 else if (STRINGP (definition
) || VECTORP (definition
))
3150 insert1 (Fkey_description (definition
, Qnil
));
3151 insert_string ("\n");
3153 else if (KEYMAPP (definition
))
3154 insert_string ("Prefix Command\n");
3156 insert_string ("??\n");
3159 /* Describe the contents of map MAP, assuming that this map itself is
3160 reached by the sequence of prefix keys PREFIX (a string or vector).
3161 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3164 describe_map (map
, prefix
, elt_describer
, partial
, shadow
,
3165 seen
, nomenu
, mention_shadow
)
3166 register Lisp_Object map
;
3168 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3175 Lisp_Object tail
, definition
, event
;
3177 Lisp_Object suppress
;
3180 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3185 suppress
= intern ("suppress-keymap");
3187 /* This vector gets used to present single keys to Flookup_key. Since
3188 that is done once per keymap element, we don't want to cons up a
3189 fresh vector every time. */
3190 kludge
= Fmake_vector (make_number (1), Qnil
);
3193 GCPRO3 (prefix
, definition
, kludge
);
3195 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3199 if (VECTORP (XCAR (tail
))
3200 || CHAR_TABLE_P (XCAR (tail
)))
3201 describe_vector (XCAR (tail
),
3202 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3203 (int *)0, 0, 1, mention_shadow
);
3204 else if (CONSP (XCAR (tail
)))
3206 int this_shadowed
= 0;
3207 event
= XCAR (XCAR (tail
));
3209 /* Ignore bindings whose "prefix" are not really valid events.
3210 (We get these in the frames and buffers menu.) */
3211 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3214 if (nomenu
&& EQ (event
, Qmenu_bar
))
3217 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3219 /* Don't show undefined commands or suppressed commands. */
3220 if (NILP (definition
)) continue;
3221 if (SYMBOLP (definition
) && partial
)
3223 tem
= Fget (definition
, suppress
);
3228 /* Don't show a command that isn't really visible
3229 because a local definition of the same key shadows it. */
3231 ASET (kludge
, 0, event
);
3234 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3244 tem
= Flookup_key (map
, kludge
, Qt
);
3245 if (!EQ (tem
, definition
)) continue;
3249 previous_description_column
= 0;
3254 /* THIS gets the string to describe the character EVENT. */
3255 insert1 (Fkey_description (kludge
, prefix
));
3257 /* Print a description of the definition of this character.
3258 elt_describer will take care of spacing out far enough
3259 for alignment purposes. */
3260 (*elt_describer
) (definition
, Qnil
);
3265 insert_string (" (binding currently shadowed)");
3269 else if (EQ (XCAR (tail
), Qkeymap
))
3271 /* The same keymap might be in the structure twice, if we're
3272 using an inherited keymap. So skip anything we've already
3274 tem
= Fassq (tail
, *seen
);
3275 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3277 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3285 describe_vector_princ (elt
, fun
)
3286 Lisp_Object elt
, fun
;
3288 Findent_to (make_number (16), make_number (1));
3293 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3294 doc
: /* Insert a description of contents of VECTOR.
3295 This is text showing the elements of vector matched against indices.
3296 DESCRIBER is the output function used; nil means use `princ'. */)
3298 Lisp_Object vector
, describer
;
3300 int count
= SPECPDL_INDEX ();
3301 if (NILP (describer
))
3302 describer
= intern ("princ");
3303 specbind (Qstandard_output
, Fcurrent_buffer ());
3304 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3305 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3306 Qnil
, Qnil
, (int *)0, 0, 0, 0);
3308 return unbind_to (count
, Qnil
);
3311 /* Insert in the current buffer a description of the contents of VECTOR.
3312 We call ELT_DESCRIBER to insert the description of one value found
3315 ELT_PREFIX describes what "comes before" the keys or indices defined
3316 by this vector. This is a human-readable string whose size
3317 is not necessarily related to the situation.
3319 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3320 leads to this keymap.
3322 If the vector is a chartable, ELT_PREFIX is the vector
3323 of bytes that lead to the character set or portion of a character
3324 set described by this chartable.
3326 If PARTIAL is nonzero, it means do not mention suppressed commands
3327 (that assumes the vector is in a keymap).
3329 SHADOW is a list of keymaps that shadow this map.
3330 If it is non-nil, then we look up the key in those maps
3331 and we don't mention it now if it is defined by any of them.
3333 ENTIRE_MAP is the keymap in which this vector appears.
3334 If the definition in effect in the whole map does not match
3335 the one in this vector, we ignore this one.
3337 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3339 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3342 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3344 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3347 describe_vector (vector
, prefix
, args
, elt_describer
,
3348 partial
, shadow
, entire_map
,
3349 indices
, char_table_depth
, keymap_p
,
3351 register Lisp_Object vector
;
3352 Lisp_Object prefix
, args
;
3353 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3356 Lisp_Object entire_map
;
3358 int char_table_depth
;
3362 Lisp_Object definition
;
3364 Lisp_Object elt_prefix
= Qnil
;
3366 Lisp_Object suppress
;
3369 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3370 /* Range of elements to be handled. */
3372 Lisp_Object character
;
3381 /* Call Fkey_description first, to avoid GC bug for the other string. */
3382 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3385 tem
= Fkey_description (prefix
, Qnil
);
3386 elt_prefix
= concat2 (tem
, build_string (" "));
3391 /* This vector gets used to present single keys to Flookup_key. Since
3392 that is done once per vector element, we don't want to cons up a
3393 fresh vector every time. */
3394 kludge
= Fmake_vector (make_number (1), Qnil
);
3395 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3398 suppress
= intern ("suppress-keymap");
3401 to
= CHAR_TABLE_P (vector
) ? MAX_CHAR
+ 1 : XVECTOR (vector
)->size
;
3403 for (i
= from
; i
< to
; i
++)
3405 int this_shadowed
= 0;
3406 int range_beg
, range_end
;
3413 if (CHAR_TABLE_P (vector
))
3414 val
= char_table_ref_and_range (vector
, i
, &range_beg
, &i
);
3416 val
= AREF (vector
, i
);
3417 definition
= get_keyelt (val
, 0);
3419 if (NILP (definition
)) continue;
3421 /* Don't mention suppressed commands. */
3422 if (SYMBOLP (definition
) && partial
)
3426 tem
= Fget (definition
, suppress
);
3428 if (!NILP (tem
)) continue;
3431 character
= make_number (starting_i
);
3432 ASET (kludge
, 0, character
);
3434 /* If this binding is shadowed by some other map, ignore it. */
3439 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3450 /* Ignore this definition if it is shadowed by an earlier
3451 one in the same keymap. */
3452 if (!NILP (entire_map
))
3456 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3458 if (!EQ (tem
, definition
))
3468 /* Output the prefix that applies to every entry in this map. */
3469 if (!NILP (elt_prefix
))
3470 insert1 (elt_prefix
);
3472 insert1 (Fkey_description (kludge
, prefix
));
3474 /* Find all consecutive characters or rows that have the same
3475 definition. But, for elements of a top level char table, if
3476 they are for charsets, we had better describe one by one even
3477 if they have the same definition. */
3478 if (CHAR_TABLE_P (vector
))
3480 && (val
= char_table_ref_and_range (vector
, i
+ 1,
3481 &range_beg
, &range_end
),
3482 tem2
= get_keyelt (val
, 0),
3484 && !NILP (Fequal (tem2
, definition
)))
3488 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3490 && !NILP (Fequal (tem2
, definition
)))
3493 /* If we have a range of more than one character,
3494 print where the range reaches to. */
3496 if (i
!= starting_i
)
3500 ASET (kludge
, 0, make_number (i
));
3502 if (!NILP (elt_prefix
))
3503 insert1 (elt_prefix
);
3505 insert1 (Fkey_description (kludge
, prefix
));
3508 /* Print a description of the definition of this character.
3509 elt_describer will take care of spacing out far enough
3510 for alignment purposes. */
3511 (*elt_describer
) (definition
, args
);
3516 insert_string (" (binding currently shadowed)");
3521 if (CHAR_TABLE_P (vector
) && ! NILP (XCHAR_TABLE (vector
)->defalt
))
3523 if (!NILP (elt_prefix
))
3524 insert1 (elt_prefix
);
3525 insert ("default", 7);
3526 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3532 /* Apropos - finding all symbols whose names match a regexp. */
3533 static Lisp_Object apropos_predicate
;
3534 static Lisp_Object apropos_accumulate
;
3537 apropos_accum (symbol
, string
)
3538 Lisp_Object symbol
, string
;
3540 register Lisp_Object tem
;
3542 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3543 if (!NILP (tem
) && !NILP (apropos_predicate
))
3544 tem
= call1 (apropos_predicate
, symbol
);
3546 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3549 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3550 doc
: /* Show all symbols whose names contain match for REGEXP.
3551 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3552 for each symbol and a symbol is mentioned only if that returns non-nil.
3553 Return list of symbols found. */)
3555 Lisp_Object regexp
, predicate
;
3558 CHECK_STRING (regexp
);
3559 apropos_predicate
= predicate
;
3560 apropos_accumulate
= Qnil
;
3561 map_obarray (Vobarray
, apropos_accum
, regexp
);
3562 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3563 apropos_accumulate
= Qnil
;
3564 apropos_predicate
= Qnil
;
3571 Qkeymap
= intern ("keymap");
3572 staticpro (&Qkeymap
);
3573 staticpro (&apropos_predicate
);
3574 staticpro (&apropos_accumulate
);
3575 apropos_predicate
= Qnil
;
3576 apropos_accumulate
= Qnil
;
3578 /* Now we are ready to set up this property, so we can
3579 create char tables. */
3580 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3582 /* Initialize the keymaps standardly used.
3583 Each one is the value of a Lisp variable, and is also
3584 pointed to by a C variable */
3586 global_map
= Fmake_keymap (Qnil
);
3587 Fset (intern ("global-map"), global_map
);
3589 current_global_map
= global_map
;
3590 staticpro (&global_map
);
3591 staticpro (¤t_global_map
);
3593 meta_map
= Fmake_keymap (Qnil
);
3594 Fset (intern ("esc-map"), meta_map
);
3595 Ffset (intern ("ESC-prefix"), meta_map
);
3597 control_x_map
= Fmake_keymap (Qnil
);
3598 Fset (intern ("ctl-x-map"), control_x_map
);
3599 Ffset (intern ("Control-X-prefix"), control_x_map
);
3602 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3603 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3604 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3605 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3606 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3608 staticpro (&exclude_keys
);
3610 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3611 doc
: /* List of commands given new key bindings recently.
3612 This is used for internal purposes during Emacs startup;
3613 don't alter it yourself. */);
3614 Vdefine_key_rebound_commands
= Qt
;
3616 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3617 doc
: /* Default keymap to use when reading from the minibuffer. */);
3618 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3620 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3621 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3622 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3623 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3625 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3626 doc
: /* Local keymap for minibuffer input with completion. */);
3627 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3628 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3630 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3631 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3632 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3633 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3634 Vminibuffer_local_completion_map
);
3636 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3637 doc
: /* Alist of keymaps to use for minor modes.
3638 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3639 key sequences and look up bindings iff VARIABLE's value is non-nil.
3640 If two active keymaps bind the same key, the keymap appearing earlier
3641 in the list takes precedence. */);
3642 Vminor_mode_map_alist
= Qnil
;
3644 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3645 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3646 This variable is an alist just like `minor-mode-map-alist', and it is
3647 used the same way (and before `minor-mode-map-alist'); however,
3648 it is provided for major modes to bind locally. */);
3649 Vminor_mode_overriding_map_alist
= Qnil
;
3651 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3652 doc
: /* List of keymap alists to use for emulations modes.
3653 It is intended for modes or packages using multiple minor-mode keymaps.
3654 Each element is a keymap alist just like `minor-mode-map-alist', or a
3655 symbol with a variable binding which is a keymap alist, and it is used
3656 the same way. The "active" keymaps in each alist are used before
3657 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3658 Vemulation_mode_map_alists
= Qnil
;
3661 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3662 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3663 This allows Emacs to recognize function keys sent from ASCII
3664 terminals at any point in a key sequence.
3666 The `read-key-sequence' function replaces any subsequence bound by
3667 `function-key-map' with its binding. More precisely, when the active
3668 keymaps have no binding for the current key sequence but
3669 `function-key-map' binds a suffix of the sequence to a vector or string,
3670 `read-key-sequence' replaces the matching suffix with its binding, and
3671 continues with the new sequence.
3673 The events that come from bindings in `function-key-map' are not
3674 themselves looked up in `function-key-map'.
3676 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3677 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3678 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3679 key, typing `ESC O P x' would return [f1 x]. */);
3680 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3682 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3683 doc
: /* Keymap of key translations that can override keymaps.
3684 This keymap works like `function-key-map', but comes after that,
3685 and its non-prefix bindings override ordinary bindings. */);
3686 Vkey_translation_map
= Qnil
;
3688 staticpro (&Vmouse_events
);
3689 Vmouse_events
= Fcons (intern ("menu-bar"),
3690 Fcons (intern ("tool-bar"),
3691 Fcons (intern ("header-line"),
3692 Fcons (intern ("mode-line"),
3693 Fcons (intern ("mouse-1"),
3694 Fcons (intern ("mouse-2"),
3695 Fcons (intern ("mouse-3"),
3696 Fcons (intern ("mouse-4"),
3697 Fcons (intern ("mouse-5"),
3701 Qsingle_key_description
= intern ("single-key-description");
3702 staticpro (&Qsingle_key_description
);
3704 Qkey_description
= intern ("key-description");
3705 staticpro (&Qkey_description
);
3707 Qkeymapp
= intern ("keymapp");
3708 staticpro (&Qkeymapp
);
3710 Qnon_ascii
= intern ("non-ascii");
3711 staticpro (&Qnon_ascii
);
3713 Qmenu_item
= intern ("menu-item");
3714 staticpro (&Qmenu_item
);
3716 Qremap
= intern ("remap");
3717 staticpro (&Qremap
);
3719 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3720 staticpro (&command_remapping_vector
);
3722 where_is_cache_keymaps
= Qt
;
3723 where_is_cache
= Qnil
;
3724 staticpro (&where_is_cache
);
3725 staticpro (&where_is_cache_keymaps
);
3727 defsubr (&Skeymapp
);
3728 defsubr (&Skeymap_parent
);
3729 defsubr (&Skeymap_prompt
);
3730 defsubr (&Sset_keymap_parent
);
3731 defsubr (&Smake_keymap
);
3732 defsubr (&Smake_sparse_keymap
);
3733 defsubr (&Smap_keymap
);
3734 defsubr (&Scopy_keymap
);
3735 defsubr (&Scommand_remapping
);
3736 defsubr (&Skey_binding
);
3737 defsubr (&Slocal_key_binding
);
3738 defsubr (&Sglobal_key_binding
);
3739 defsubr (&Sminor_mode_key_binding
);
3740 defsubr (&Sdefine_key
);
3741 defsubr (&Slookup_key
);
3742 defsubr (&Sdefine_prefix_command
);
3743 defsubr (&Suse_global_map
);
3744 defsubr (&Suse_local_map
);
3745 defsubr (&Scurrent_local_map
);
3746 defsubr (&Scurrent_global_map
);
3747 defsubr (&Scurrent_minor_mode_maps
);
3748 defsubr (&Scurrent_active_maps
);
3749 defsubr (&Saccessible_keymaps
);
3750 defsubr (&Skey_description
);
3751 defsubr (&Sdescribe_vector
);
3752 defsubr (&Ssingle_key_description
);
3753 defsubr (&Stext_char_description
);
3754 defsubr (&Swhere_is_internal
);
3755 defsubr (&Sdescribe_buffer_bindings
);
3756 defsubr (&Sapropos_internal
);
3762 initial_define_key (global_map
, 033, "ESC-prefix");
3763 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3766 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3767 (do not change this comment) */