1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
30 #include "termhooks.h"
31 #include "blockinput.h"
33 #include "intervals.h"
36 /* The number of elements in keymap vectors. */
37 #define DENSE_TABLE_SIZE (0200)
39 /* Actually allocate storage for these variables */
41 Lisp_Object current_global_map
; /* Current global keymap */
43 Lisp_Object global_map
; /* default global key bindings */
45 Lisp_Object meta_map
; /* The keymap used for globally bound
46 ESC-prefixed default commands */
48 Lisp_Object control_x_map
; /* The keymap used for globally bound
49 C-x-prefixed default commands */
51 /* was MinibufLocalMap */
52 Lisp_Object Vminibuffer_local_map
;
53 /* The keymap used by the minibuf for local
54 bindings when spaces are allowed in the
57 /* was MinibufLocalNSMap */
58 Lisp_Object Vminibuffer_local_ns_map
;
59 /* The keymap used by the minibuf for local
60 bindings when spaces are not encouraged
63 /* keymap used for minibuffers when doing completion */
64 /* was MinibufLocalCompletionMap */
65 Lisp_Object Vminibuffer_local_completion_map
;
67 /* keymap used for minibuffers when doing completion and require a match */
68 /* was MinibufLocalMustMatchMap */
69 Lisp_Object Vminibuffer_local_must_match_map
;
71 /* Alist of minor mode variables and keymaps. */
72 Lisp_Object Vminor_mode_map_alist
;
74 /* Alist of major-mode-specific overrides for
75 minor mode variables and keymaps. */
76 Lisp_Object Vminor_mode_overriding_map_alist
;
78 /* List of emulation mode keymap alists. */
79 Lisp_Object Vemulation_mode_map_alists
;
81 /* Keymap mapping ASCII function key sequences onto their preferred forms.
82 Initialized by the terminal-specific lisp files. See DEFVAR for more
84 Lisp_Object Vfunction_key_map
;
86 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
87 Lisp_Object Vkey_translation_map
;
89 /* A list of all commands given new bindings since a certain time
90 when nil was stored here.
91 This is used to speed up recomputation of menu key equivalents
92 when Emacs starts up. t means don't record anything here. */
93 Lisp_Object Vdefine_key_rebound_commands
;
95 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
, Qmenu_item
, Qremap
;
97 /* Alist of elements like (DEL . "\d"). */
98 static Lisp_Object exclude_keys
;
100 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
101 static Lisp_Object command_remapping_vector
;
103 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
104 in a string key sequence is equivalent to prefixing with this
106 extern Lisp_Object meta_prefix_char
;
108 extern Lisp_Object Voverriding_local_map
;
110 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
111 static Lisp_Object where_is_cache
;
112 /* Which keymaps are reverse-stored in the cache. */
113 static Lisp_Object where_is_cache_keymaps
;
115 static Lisp_Object store_in_keymap
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
116 static void fix_submap_inheritance
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
118 static Lisp_Object define_as_prefix
P_ ((Lisp_Object
, Lisp_Object
));
119 static void describe_command
P_ ((Lisp_Object
, Lisp_Object
));
120 static void describe_translation
P_ ((Lisp_Object
, Lisp_Object
));
121 static void describe_map
P_ ((Lisp_Object
, Lisp_Object
,
122 void (*) P_ ((Lisp_Object
, Lisp_Object
)),
123 int, Lisp_Object
, Lisp_Object
*, int));
124 static void describe_vector
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
125 void (*) (Lisp_Object
, Lisp_Object
), int,
126 Lisp_Object
, Lisp_Object
, int *, int, int));
127 static void silly_event_symbol_error
P_ ((Lisp_Object
));
129 /* Keymap object support - constructors and predicates. */
131 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
132 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
133 CHARTABLE is a char-table that holds the bindings for the ASCII
134 characters. ALIST is an assoc-list which holds bindings for function keys,
135 mouse events, and any other things that appear in the input stream.
136 All entries in it are initially nil, meaning "command undefined".
138 The optional arg STRING supplies a menu name for the keymap
139 in case you use it as a menu with `x-popup-menu'. */)
145 tail
= Fcons (string
, Qnil
);
148 return Fcons (Qkeymap
,
149 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
152 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
153 doc
: /* Construct and return a new sparse keymap.
154 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
155 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
156 which binds the function key or mouse event SYMBOL to DEFINITION.
157 Initially the alist is nil.
159 The optional arg STRING supplies a menu name for the keymap
160 in case you use it as a menu with `x-popup-menu'. */)
165 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
166 return Fcons (Qkeymap
, Qnil
);
169 /* This function is used for installing the standard key bindings
170 at initialization time.
174 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
177 initial_define_key (keymap
, key
, defname
)
182 store_in_keymap (keymap
, make_number (key
), intern (defname
));
186 initial_define_lispy_key (keymap
, keyname
, defname
)
191 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
194 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
195 doc
: /* Return t if OBJECT is a keymap.
197 A keymap is a list (keymap . ALIST),
198 or a symbol whose function definition is itself a keymap.
199 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
200 a vector of densely packed bindings for small character codes
201 is also allowed as an element. */)
205 return (KEYMAPP (object
) ? Qt
: Qnil
);
208 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
209 doc
: /* Return the prompt-string of a keymap MAP.
210 If non-nil, the prompt is shown in the echo-area
211 when reading a key-sequence to be looked-up in this keymap. */)
217 register Lisp_Object tem
;
226 /* Check that OBJECT is a keymap (after dereferencing through any
227 symbols). If it is, return it.
229 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
230 is an autoload form, do the autoload and try again.
231 If AUTOLOAD is nonzero, callers must assume GC is possible.
233 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
234 is zero as well), return Qt.
236 ERROR controls how we respond if OBJECT isn't a keymap.
237 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
239 Note that most of the time, we don't want to pursue autoloads.
240 Functions like Faccessible_keymaps which scan entire keymap trees
241 shouldn't load every autoloaded keymap. I'm not sure about this,
242 but it seems to me that only read_key_sequence, Flookup_key, and
243 Fdefine_key should cause keymaps to be autoloaded.
245 This function can GC when AUTOLOAD is non-zero, because it calls
246 do_autoload which can GC. */
249 get_keymap (object
, error
, autoload
)
258 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
261 tem
= indirect_function (object
);
264 if (EQ (XCAR (tem
), Qkeymap
))
267 /* Should we do an autoload? Autoload forms for keymaps have
268 Qkeymap as their fifth element. */
269 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
))
273 tail
= Fnth (make_number (4), tem
);
274 if (EQ (tail
, Qkeymap
))
278 struct gcpro gcpro1
, gcpro2
;
280 GCPRO2 (tem
, object
);
281 do_autoload (tem
, object
);
294 wrong_type_argument (Qkeymapp
, object
);
298 /* Return the parent map of KEYMAP, or nil if it has none.
299 We assume that KEYMAP is a valid keymap. */
302 keymap_parent (keymap
, autoload
)
308 keymap
= get_keymap (keymap
, 1, autoload
);
310 /* Skip past the initial element `keymap'. */
311 list
= XCDR (keymap
);
312 for (; CONSP (list
); list
= XCDR (list
))
314 /* See if there is another `keymap'. */
319 return get_keymap (list
, 0, autoload
);
322 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
323 doc
: /* Return the parent keymap of KEYMAP. */)
327 return keymap_parent (keymap
, 1);
330 /* Check whether MAP is one of MAPS parents. */
332 keymap_memberp (map
, maps
)
333 Lisp_Object map
, maps
;
335 if (NILP (map
)) return 0;
336 while (KEYMAPP (maps
) && !EQ (map
, maps
))
337 maps
= keymap_parent (maps
, 0);
338 return (EQ (map
, maps
));
341 /* Set the parent keymap of MAP to PARENT. */
343 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
344 doc
: /* Modify KEYMAP to set its parent map to PARENT.
345 Return PARENT. PARENT should be nil or another keymap. */)
347 Lisp_Object keymap
, parent
;
349 Lisp_Object list
, prev
;
350 struct gcpro gcpro1
, gcpro2
;
353 /* Force a keymap flush for the next call to where-is.
354 Since this can be called from within where-is, we don't set where_is_cache
355 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
356 be changed during where-is, while where_is_cache_keymaps is only used at
357 the very beginning of where-is and can thus be changed here without any
359 This is a very minor correctness (rather than safety) issue. */
360 where_is_cache_keymaps
= Qt
;
362 GCPRO2 (keymap
, parent
);
363 keymap
= get_keymap (keymap
, 1, 1);
367 parent
= get_keymap (parent
, 1, 1);
369 /* Check for cycles. */
370 if (keymap_memberp (keymap
, parent
))
371 error ("Cyclic keymap inheritance");
374 /* Skip past the initial element `keymap'. */
379 /* If there is a parent keymap here, replace it.
380 If we came to the end, add the parent in PREV. */
381 if (!CONSP (list
) || KEYMAPP (list
))
383 /* If we already have the right parent, return now
384 so that we avoid the loops below. */
385 if (EQ (XCDR (prev
), parent
))
386 RETURN_UNGCPRO (parent
);
388 XSETCDR (prev
, parent
);
394 /* Scan through for submaps, and set their parents too. */
396 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
398 /* Stop the scan when we come to the parent. */
399 if (EQ (XCAR (list
), Qkeymap
))
402 /* If this element holds a prefix map, deal with it. */
403 if (CONSP (XCAR (list
))
404 && CONSP (XCDR (XCAR (list
))))
405 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
408 if (VECTORP (XCAR (list
)))
409 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
410 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
411 fix_submap_inheritance (keymap
, make_number (i
),
412 XVECTOR (XCAR (list
))->contents
[i
]);
414 if (CHAR_TABLE_P (XCAR (list
)))
416 Lisp_Object indices
[3];
418 map_char_table (fix_submap_inheritance
, Qnil
,
419 XCAR (list
), XCAR (list
),
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 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
530 t_ok
, noinherit
, autoload
),
533 if (CONSP (meta_map
))
536 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
539 /* Set IDX to t, so that we only find a default binding. */
542 /* We know there is no binding. */
546 /* t_binding is where we put a default binding that applies,
547 to use in case we do not find a binding specifically
548 for this key sequence. */
551 Lisp_Object t_binding
= Qnil
;
552 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
554 GCPRO4 (map
, tail
, idx
, t_binding
);
556 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
557 If it is 1, only generic-char bindings are accepted.
558 Otherwise, neither are. */
561 for (tail
= XCDR (map
);
563 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
568 binding
= XCAR (tail
);
569 if (SYMBOLP (binding
))
571 /* If NOINHERIT, stop finding prefix definitions
572 after we pass a second occurrence of the `keymap' symbol. */
573 if (noinherit
&& EQ (binding
, Qkeymap
))
574 RETURN_UNGCPRO (Qnil
);
576 else if (CONSP (binding
))
578 Lisp_Object key
= XCAR (binding
);
581 val
= XCDR (binding
);
584 && (XINT (idx
) & CHAR_MODIFIER_MASK
) == 0
586 && (XINT (key
) & CHAR_MODIFIER_MASK
) == 0
587 && !SINGLE_BYTE_CHAR_P (XINT (idx
))
588 && !SINGLE_BYTE_CHAR_P (XINT (key
))
589 && CHAR_VALID_P (XINT (key
), 1)
590 && !CHAR_VALID_P (XINT (key
), 0)
591 && (CHAR_CHARSET (XINT (key
))
592 == CHAR_CHARSET (XINT (idx
))))
594 /* KEY is the generic character of the charset of IDX.
595 Use KEY's binding if there isn't a binding for IDX
597 t_binding
= XCDR (binding
);
600 else if (t_ok
> 1 && EQ (key
, Qt
))
602 t_binding
= XCDR (binding
);
606 else if (VECTORP (binding
))
608 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
609 val
= AREF (binding
, XFASTINT (idx
));
611 else if (CHAR_TABLE_P (binding
))
613 /* Character codes with modifiers
614 are not included in a char-table.
615 All character codes without modifiers are included. */
616 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
618 val
= Faref (binding
, idx
);
619 /* `nil' has a special meaning for char-tables, so
620 we use something else to record an explicitly
627 /* If we found a binding, clean it up and return it. */
628 if (!EQ (val
, Qunbound
))
631 /* A Qt binding is just like an explicit nil binding
632 (i.e. it shadows any parent binding but not bindings in
633 keymaps of lower precedence). */
635 val
= get_keyelt (val
, autoload
);
637 fix_submap_inheritance (map
, idx
, val
);
638 RETURN_UNGCPRO (val
);
643 return get_keyelt (t_binding
, autoload
);
648 map_keymap_item (fun
, args
, key
, val
, data
)
649 map_keymap_function_t fun
;
650 Lisp_Object args
, key
, val
;
653 /* We should maybe try to detect bindings shadowed by previous
654 ones and things like that. */
657 (*fun
) (key
, val
, args
, data
);
661 map_keymap_char_table_item (args
, key
, val
)
662 Lisp_Object args
, key
, val
;
666 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
668 map_keymap_item (fun
, XCDR (args
), key
, val
,
669 XSAVE_VALUE (XCAR (args
))->pointer
);
673 /* Call FUN for every binding in MAP.
674 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
675 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
677 map_keymap (map
, fun
, args
, data
, autoload
)
678 map_keymap_function_t fun
;
679 Lisp_Object map
, args
;
683 struct gcpro gcpro1
, gcpro2
, gcpro3
;
686 GCPRO3 (map
, args
, tail
);
687 map
= get_keymap (map
, 1, autoload
);
688 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
689 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
692 Lisp_Object binding
= XCAR (tail
);
695 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
696 else if (VECTORP (binding
))
698 /* Loop over the char values represented in the vector. */
699 int len
= ASIZE (binding
);
701 for (c
= 0; c
< len
; c
++)
703 Lisp_Object character
;
704 XSETFASTINT (character
, c
);
705 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
708 else if (CHAR_TABLE_P (binding
))
710 Lisp_Object indices
[3];
711 map_char_table (map_keymap_char_table_item
, Qnil
, binding
, binding
,
712 Fcons (make_save_value (fun
, 0),
713 Fcons (make_save_value (data
, 0),
722 map_keymap_call (key
, val
, fun
, dummy
)
723 Lisp_Object key
, val
, fun
;
726 call2 (fun
, key
, val
);
729 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 2, 0,
730 doc
: /* Call FUNCTION for every binding in KEYMAP.
731 FUNCTION is called with two arguments: the event and its binding. */)
733 Lisp_Object function
, keymap
;
735 if (INTEGERP (function
))
736 /* We have to stop integers early since map_keymap gives them special
738 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
739 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
743 /* Given OBJECT which was found in a slot in a keymap,
744 trace indirect definitions to get the actual definition of that slot.
745 An indirect definition is a list of the form
746 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
747 and INDEX is the object to look up in KEYMAP to yield the definition.
749 Also if OBJECT has a menu string as the first element,
750 remove that. Also remove a menu help string as second element.
752 If AUTOLOAD is nonzero, load autoloadable keymaps
753 that are referred to with indirection. */
756 get_keyelt (object
, autoload
)
762 if (!(CONSP (object
)))
763 /* This is really the value. */
766 /* If the keymap contents looks like (keymap ...) or (lambda ...)
768 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
771 /* If the keymap contents looks like (menu-item name . DEFN)
772 or (menu-item name DEFN ...) then use DEFN.
773 This is a new format menu item. */
774 else if (EQ (XCAR (object
), Qmenu_item
))
776 if (CONSP (XCDR (object
)))
780 object
= XCDR (XCDR (object
));
783 object
= XCAR (object
);
785 /* If there's a `:filter FILTER', apply FILTER to the
786 menu-item's definition to get the real definition to
788 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
789 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
792 filter
= XCAR (XCDR (tem
));
793 filter
= list2 (filter
, list2 (Qquote
, object
));
794 object
= menu_item_eval_property (filter
);
799 /* Invalid keymap. */
803 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
804 Keymap alist elements like (CHAR MENUSTRING . DEFN)
805 will be used by HierarKey menus. */
806 else if (STRINGP (XCAR (object
)))
808 object
= XCDR (object
);
809 /* Also remove a menu help string, if any,
810 following the menu item name. */
811 if (CONSP (object
) && STRINGP (XCAR (object
)))
812 object
= XCDR (object
);
813 /* Also remove the sublist that caches key equivalences, if any. */
814 if (CONSP (object
) && CONSP (XCAR (object
)))
817 carcar
= XCAR (XCAR (object
));
818 if (NILP (carcar
) || VECTORP (carcar
))
819 object
= XCDR (object
);
823 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
829 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
831 return (!CONSP (map
) ? object
/* Invalid keymap */
832 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
838 store_in_keymap (keymap
, idx
, def
)
840 register Lisp_Object idx
;
841 register Lisp_Object def
;
843 /* Flush any reverse-map cache. */
844 where_is_cache
= Qnil
;
845 where_is_cache_keymaps
= Qt
;
847 /* If we are preparing to dump, and DEF is a menu element
848 with a menu item indicator, copy it to ensure it is not pure. */
849 if (CONSP (def
) && PURE_P (def
)
850 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
851 def
= Fcons (XCAR (def
), XCDR (def
));
853 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
854 error ("attempt to define a key in a non-keymap");
856 /* If idx is a list (some sort of mouse click, perhaps?),
857 the index we want to use is the car of the list, which
858 ought to be a symbol. */
859 idx
= EVENT_HEAD (idx
);
861 /* If idx is a symbol, it might have modifiers, which need to
862 be put in the canonical order. */
864 idx
= reorder_modifiers (idx
);
865 else if (INTEGERP (idx
))
866 /* Clobber the high bits that can be present on a machine
867 with more than 24 bits of integer. */
868 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
870 /* Scan the keymap for a binding of idx. */
874 /* The cons after which we should insert new bindings. If the
875 keymap has a table element, we record its position here, so new
876 bindings will go after it; this way, the table will stay
877 towards the front of the alist and character lookups in dense
878 keymaps will remain fast. Otherwise, this just points at the
879 front of the keymap. */
880 Lisp_Object insertion_point
;
882 insertion_point
= keymap
;
883 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
890 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
892 ASET (elt
, XFASTINT (idx
), def
);
895 insertion_point
= tail
;
897 else if (CHAR_TABLE_P (elt
))
899 /* Character codes with modifiers
900 are not included in a char-table.
901 All character codes without modifiers are included. */
902 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
905 /* `nil' has a special meaning for char-tables, so
906 we use something else to record an explicitly
908 NILP (def
) ? Qt
: def
);
911 insertion_point
= tail
;
913 else if (CONSP (elt
))
915 if (EQ (idx
, XCAR (elt
)))
921 else if (EQ (elt
, Qkeymap
))
922 /* If we find a 'keymap' symbol in the spine of KEYMAP,
923 then we must have found the start of a second keymap
924 being used as the tail of KEYMAP, and a binding for IDX
925 should be inserted before it. */
932 /* We have scanned the entire keymap, and not found a binding for
933 IDX. Let's add one. */
934 XSETCDR (insertion_point
,
935 Fcons (Fcons (idx
, def
), XCDR (insertion_point
)));
941 EXFUN (Fcopy_keymap
, 1);
944 copy_keymap_item (elt
)
947 Lisp_Object res
, tem
;
954 /* Is this a new format menu item. */
955 if (EQ (XCAR (tem
), Qmenu_item
))
957 /* Copy cell with menu-item marker. */
958 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
962 /* Copy cell with menu-item name. */
963 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
969 /* Copy cell with binding and if the binding is a keymap,
971 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
974 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
975 XSETCAR (elt
, Fcopy_keymap (tem
));
977 if (CONSP (tem
) && CONSP (XCAR (tem
)))
978 /* Delete cache for key equivalences. */
979 XSETCDR (elt
, XCDR (tem
));
984 /* It may be an old fomat menu item.
985 Skip the optional menu string. */
986 if (STRINGP (XCAR (tem
)))
988 /* Copy the cell, since copy-alist didn't go this deep. */
989 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
991 /* Also skip the optional menu help string. */
992 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
994 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
998 /* There may also be a list that caches key equivalences.
999 Just delete it for the new keymap. */
1001 && CONSP (XCAR (tem
))
1002 && (NILP (XCAR (XCAR (tem
)))
1003 || VECTORP (XCAR (XCAR (tem
)))))
1005 XSETCDR (elt
, XCDR (tem
));
1008 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1009 XSETCDR (elt
, Fcopy_keymap (tem
));
1011 else if (EQ (XCAR (tem
), Qkeymap
))
1012 res
= Fcopy_keymap (elt
);
1018 copy_keymap_1 (chartable
, idx
, elt
)
1019 Lisp_Object chartable
, idx
, elt
;
1021 Faset (chartable
, idx
, copy_keymap_item (elt
));
1024 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1025 doc
: /* Return a copy of the keymap KEYMAP.
1026 The copy starts out with the same definitions of KEYMAP,
1027 but changing either the copy or KEYMAP does not affect the other.
1028 Any key definitions that are subkeymaps are recursively copied.
1029 However, a key definition which is a symbol whose definition is a keymap
1034 register Lisp_Object copy
, tail
;
1035 keymap
= get_keymap (keymap
, 1, 0);
1036 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1037 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1039 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1041 Lisp_Object elt
= XCAR (keymap
);
1042 if (CHAR_TABLE_P (elt
))
1044 Lisp_Object indices
[3];
1045 elt
= Fcopy_sequence (elt
);
1046 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, elt
, 0, indices
);
1048 else if (VECTORP (elt
))
1051 elt
= Fcopy_sequence (elt
);
1052 for (i
= 0; i
< ASIZE (elt
); i
++)
1053 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1055 else if (CONSP (elt
))
1056 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1057 XSETCDR (tail
, Fcons (elt
, Qnil
));
1059 keymap
= XCDR (keymap
);
1061 XSETCDR (tail
, keymap
);
1065 /* Simple Keymap mutators and accessors. */
1067 /* GC is possible in this function if it autoloads a keymap. */
1069 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1070 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1073 KEY is a string or a vector of symbols and characters meaning a
1074 sequence of keystrokes and events. Non-ASCII characters with codes
1075 above 127 (such as ISO Latin-1) can be included if you use a vector.
1076 Using [t] for KEY creates a default definition, which applies to any
1077 event type that has no other definition in this keymap.
1079 DEF is anything that can be a key's definition:
1080 nil (means key is undefined in this keymap),
1081 a command (a Lisp function suitable for interactive calling),
1082 a string (treated as a keyboard macro),
1083 a keymap (to define a prefix key),
1084 a symbol (when the key is looked up, the symbol will stand for its
1085 function definition, which should at that time be one of the above,
1086 or another symbol whose function definition is used, etc.),
1087 a cons (STRING . DEFN), meaning that DEFN is the definition
1088 (DEFN should be a valid definition in its own right),
1089 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1091 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1092 binding is altered. If there is no binding for KEY, the new pair
1093 binding KEY to DEF is added at the front of KEYMAP. */)
1100 register Lisp_Object c
;
1101 register Lisp_Object cmd
;
1105 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1107 GCPRO3 (keymap
, key
, def
);
1108 keymap
= get_keymap (keymap
, 1, 1);
1110 if (!VECTORP (key
) && !STRINGP (key
))
1111 key
= wrong_type_argument (Qarrayp
, key
);
1113 length
= XFASTINT (Flength (key
));
1115 RETURN_UNGCPRO (Qnil
);
1117 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1118 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1120 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1125 c
= Faref (key
, make_number (idx
));
1127 if (CONSP (c
) && lucid_event_type_list_p (c
))
1128 c
= Fevent_convert_list (c
);
1131 silly_event_symbol_error (c
);
1134 && (XINT (c
) & meta_bit
)
1137 c
= meta_prefix_char
;
1143 XSETINT (c
, XINT (c
) & ~meta_bit
);
1149 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
))
1150 error ("Key sequence contains invalid event");
1153 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1155 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1157 /* If this key is undefined, make it a prefix. */
1159 cmd
= define_as_prefix (keymap
, c
);
1161 keymap
= get_keymap (cmd
, 0, 1);
1162 if (!CONSP (keymap
))
1163 /* We must use Fkey_description rather than just passing key to
1164 error; key might be a vector, not a string. */
1165 error ("Key sequence %s uses invalid prefix characters",
1166 SDATA (Fkey_description (key
, Qnil
)));
1170 /* This function may GC (it calls Fkey_binding). */
1172 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1173 doc
: /* Return the remapping for command COMMAND in current keymaps.
1174 Returns nil if COMMAND is not remapped (or not a symbol). */)
1176 Lisp_Object command
;
1178 if (!SYMBOLP (command
))
1181 ASET (command_remapping_vector
, 1, command
);
1182 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1185 /* Value is number if KEY is too long; nil if valid but has no definition. */
1186 /* GC is possible in this function if it autoloads a keymap. */
1188 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1189 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1190 nil means undefined. See doc of `define-key' for kinds of definitions.
1192 A number as value means KEY is "too long";
1193 that is, characters or symbols in it except for the last one
1194 fail to be a valid sequence of prefix characters in KEYMAP.
1195 The number is how many characters at the front of KEY
1196 it takes to reach a non-prefix command.
1198 Normally, `lookup-key' ignores bindings for t, which act as default
1199 bindings, used when nothing else in the keymap applies; this makes it
1200 usable as a general function for probing keymaps. However, if the
1201 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1202 recognize the default bindings, just as `read-key-sequence' does. */)
1203 (keymap
, key
, accept_default
)
1206 Lisp_Object accept_default
;
1209 register Lisp_Object cmd
;
1210 register Lisp_Object c
;
1212 int t_ok
= !NILP (accept_default
);
1213 struct gcpro gcpro1
, gcpro2
;
1215 GCPRO2 (keymap
, key
);
1216 keymap
= get_keymap (keymap
, 1, 1);
1218 if (!VECTORP (key
) && !STRINGP (key
))
1219 key
= wrong_type_argument (Qarrayp
, key
);
1221 length
= XFASTINT (Flength (key
));
1223 RETURN_UNGCPRO (keymap
);
1228 c
= Faref (key
, make_number (idx
++));
1230 if (CONSP (c
) && lucid_event_type_list_p (c
))
1231 c
= Fevent_convert_list (c
);
1233 /* Turn the 8th bit of string chars into a meta modifier. */
1234 if (XINT (c
) & 0x80 && STRINGP (key
))
1235 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1237 /* Allow string since binding for `menu-bar-select-buffer'
1238 includes the buffer name in the key sequence. */
1239 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1240 error ("Key sequence contains invalid event");
1242 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1244 RETURN_UNGCPRO (cmd
);
1246 keymap
= get_keymap (cmd
, 0, 1);
1247 if (!CONSP (keymap
))
1248 RETURN_UNGCPRO (make_number (idx
));
1254 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1255 Assume that currently it does not define C at all.
1256 Return the keymap. */
1259 define_as_prefix (keymap
, c
)
1260 Lisp_Object keymap
, c
;
1264 cmd
= Fmake_sparse_keymap (Qnil
);
1265 /* If this key is defined as a prefix in an inherited keymap,
1266 make it a prefix in this map, and make its definition
1267 inherit the other prefix definition. */
1268 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1269 store_in_keymap (keymap
, c
, cmd
);
1274 /* Append a key to the end of a key sequence. We always make a vector. */
1277 append_key (key_sequence
, key
)
1278 Lisp_Object key_sequence
, key
;
1280 Lisp_Object args
[2];
1282 args
[0] = key_sequence
;
1284 args
[1] = Fcons (key
, Qnil
);
1285 return Fvconcat (2, args
);
1288 /* Given a event type C which is a symbol,
1289 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1292 silly_event_symbol_error (c
)
1295 Lisp_Object parsed
, base
, name
, assoc
;
1298 parsed
= parse_modifiers (c
);
1299 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1300 base
= XCAR (parsed
);
1301 name
= Fsymbol_name (base
);
1302 /* This alist includes elements such as ("RET" . "\\r"). */
1303 assoc
= Fassoc (name
, exclude_keys
);
1307 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1309 Lisp_Object keystring
;
1310 if (modifiers
& alt_modifier
)
1311 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1312 if (modifiers
& ctrl_modifier
)
1313 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1314 if (modifiers
& hyper_modifier
)
1315 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1316 if (modifiers
& meta_modifier
)
1317 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1318 if (modifiers
& shift_modifier
)
1319 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1320 if (modifiers
& super_modifier
)
1321 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1324 c
= reorder_modifiers (c
);
1325 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1327 error ((modifiers
& ~meta_modifier
1328 ? "To bind the key %s, use [?%s], not [%s]"
1329 : "To bind the key %s, use \"%s\", not [%s]"),
1330 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1331 SDATA (SYMBOL_NAME (c
)));
1335 /* Global, local, and minor mode keymap stuff. */
1337 /* We can't put these variables inside current_minor_maps, since under
1338 some systems, static gets macro-defined to be the empty string.
1340 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1341 static int cmm_size
= 0;
1343 /* Error handler used in current_minor_maps. */
1345 current_minor_maps_error ()
1350 /* Store a pointer to an array of the keymaps of the currently active
1351 minor modes in *buf, and return the number of maps it contains.
1353 This function always returns a pointer to the same buffer, and may
1354 free or reallocate it, so if you want to keep it for a long time or
1355 hand it out to lisp code, copy it. This procedure will be called
1356 for every key sequence read, so the nice lispy approach (return a
1357 new assoclist, list, what have you) for each invocation would
1358 result in a lot of consing over time.
1360 If we used xrealloc/xmalloc and ran out of memory, they would throw
1361 back to the command loop, which would try to read a key sequence,
1362 which would call this function again, resulting in an infinite
1363 loop. Instead, we'll use realloc/malloc and silently truncate the
1364 list, let the key sequence be read, and hope some other piece of
1365 code signals the error. */
1367 current_minor_maps (modeptr
, mapptr
)
1368 Lisp_Object
**modeptr
, **mapptr
;
1371 int list_number
= 0;
1372 Lisp_Object alist
, assoc
, var
, val
;
1373 Lisp_Object emulation_alists
;
1374 Lisp_Object lists
[2];
1376 emulation_alists
= Vemulation_mode_map_alists
;
1377 lists
[0] = Vminor_mode_overriding_map_alist
;
1378 lists
[1] = Vminor_mode_map_alist
;
1380 for (list_number
= 0; list_number
< 2; list_number
++)
1382 if (CONSP (emulation_alists
))
1384 alist
= XCAR (emulation_alists
);
1385 emulation_alists
= XCDR (emulation_alists
);
1386 if (SYMBOLP (alist
))
1387 alist
= find_symbol_value (alist
);
1391 alist
= lists
[list_number
];
1393 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1394 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1395 && (var
= XCAR (assoc
), SYMBOLP (var
))
1396 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1401 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1402 and also an entry in Vminor_mode_map_alist,
1403 ignore the latter. */
1404 if (list_number
== 1)
1406 val
= assq_no_quit (var
, lists
[0]);
1413 int newsize
, allocsize
;
1414 Lisp_Object
*newmodes
, *newmaps
;
1416 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1417 allocsize
= newsize
* sizeof *newmodes
;
1419 /* Use malloc here. See the comment above this function.
1420 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1422 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1427 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1430 cmm_modes
= newmodes
;
1433 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1438 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1445 if (newmodes
== NULL
|| newmaps
== NULL
)
1450 /* Get the keymap definition--or nil if it is not defined. */
1451 temp
= internal_condition_case_1 (Findirect_function
,
1453 Qerror
, current_minor_maps_error
);
1457 cmm_maps
[i
] = temp
;
1463 if (modeptr
) *modeptr
= cmm_modes
;
1464 if (mapptr
) *mapptr
= cmm_maps
;
1468 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1470 doc
: /* Return a list of the currently active keymaps.
1471 OLP if non-nil indicates that we should obey `overriding-local-map' and
1472 `overriding-terminal-local-map'. */)
1476 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1480 if (!NILP (Voverriding_local_map
))
1481 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1482 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1483 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1485 if (NILP (XCDR (keymaps
)))
1491 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1493 keymaps
= Fcons (local
, keymaps
);
1495 nmaps
= current_minor_maps (0, &maps
);
1497 for (i
= --nmaps
; i
>= 0; i
--)
1498 if (!NILP (maps
[i
]))
1499 keymaps
= Fcons (maps
[i
], keymaps
);
1501 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1503 keymaps
= Fcons (local
, keymaps
);
1509 /* GC is possible in this function if it autoloads a keymap. */
1511 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1512 doc
: /* Return the binding for command KEY in current keymaps.
1513 KEY is a string or vector, a sequence of keystrokes.
1514 The binding is probably a symbol with a function definition.
1516 Normally, `key-binding' ignores bindings for t, which act as default
1517 bindings, used when nothing else in the keymap applies; this makes it
1518 usable as a general function for probing keymaps. However, if the
1519 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1520 recognize the default bindings, just as `read-key-sequence' does.
1522 Like the normal command loop, `key-binding' will remap the command
1523 resulting from looking up KEY by looking up the command in the
1524 current keymaps. However, if the optional third argument NO-REMAP
1525 is non-nil, `key-binding' returns the unmapped command. */)
1526 (key
, accept_default
, no_remap
)
1527 Lisp_Object key
, accept_default
, no_remap
;
1529 Lisp_Object
*maps
, value
;
1531 struct gcpro gcpro1
;
1535 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1537 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1538 key
, accept_default
);
1539 if (! NILP (value
) && !INTEGERP (value
))
1542 else if (!NILP (Voverriding_local_map
))
1544 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1545 if (! NILP (value
) && !INTEGERP (value
))
1552 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1555 value
= Flookup_key (local
, key
, accept_default
);
1556 if (! NILP (value
) && !INTEGERP (value
))
1560 nmaps
= current_minor_maps (0, &maps
);
1561 /* Note that all these maps are GCPRO'd
1562 in the places where we found them. */
1564 for (i
= 0; i
< nmaps
; i
++)
1565 if (! NILP (maps
[i
]))
1567 value
= Flookup_key (maps
[i
], key
, accept_default
);
1568 if (! NILP (value
) && !INTEGERP (value
))
1572 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1575 value
= Flookup_key (local
, key
, accept_default
);
1576 if (! NILP (value
) && !INTEGERP (value
))
1581 value
= Flookup_key (current_global_map
, key
, accept_default
);
1585 if (NILP (value
) || INTEGERP (value
))
1588 /* If the result of the ordinary keymap lookup is an interactive
1589 command, look for a key binding (ie. remapping) for that command. */
1591 if (NILP (no_remap
) && SYMBOLP (value
))
1594 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1601 /* GC is possible in this function if it autoloads a keymap. */
1603 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1604 doc
: /* Return the binding for command KEYS in current local keymap only.
1605 KEYS is a string or vector, a sequence of keystrokes.
1606 The binding is probably a symbol with a function definition.
1608 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1609 bindings; see the description of `lookup-key' for more details about this. */)
1610 (keys
, accept_default
)
1611 Lisp_Object keys
, accept_default
;
1613 register Lisp_Object map
;
1614 map
= current_buffer
->keymap
;
1617 return Flookup_key (map
, keys
, accept_default
);
1620 /* GC is possible in this function if it autoloads a keymap. */
1622 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1623 doc
: /* Return the binding for command KEYS in current global keymap only.
1624 KEYS is a string or vector, a sequence of keystrokes.
1625 The binding is probably a symbol with a function definition.
1626 This function's return values are the same as those of `lookup-key'
1629 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1630 bindings; see the description of `lookup-key' for more details about this. */)
1631 (keys
, accept_default
)
1632 Lisp_Object keys
, accept_default
;
1634 return Flookup_key (current_global_map
, keys
, accept_default
);
1637 /* GC is possible in this function if it autoloads a keymap. */
1639 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1640 doc
: /* Find the visible minor mode bindings of KEY.
1641 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1642 the symbol which names the minor mode binding KEY, and BINDING is
1643 KEY's definition in that mode. In particular, if KEY has no
1644 minor-mode bindings, return nil. If the first binding is a
1645 non-prefix, all subsequent bindings will be omitted, since they would
1646 be ignored. Similarly, the list doesn't include non-prefix bindings
1647 that come after prefix bindings.
1649 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1650 bindings; see the description of `lookup-key' for more details about this. */)
1651 (key
, accept_default
)
1652 Lisp_Object key
, accept_default
;
1654 Lisp_Object
*modes
, *maps
;
1656 Lisp_Object binding
;
1658 struct gcpro gcpro1
, gcpro2
;
1660 nmaps
= current_minor_maps (&modes
, &maps
);
1661 /* Note that all these maps are GCPRO'd
1662 in the places where we found them. */
1665 GCPRO2 (key
, binding
);
1667 for (i
= j
= 0; i
< nmaps
; i
++)
1669 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1670 && !INTEGERP (binding
))
1672 if (KEYMAPP (binding
))
1673 maps
[j
++] = Fcons (modes
[i
], binding
);
1675 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1679 return Flist (j
, maps
);
1682 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1683 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1684 A new sparse keymap is stored as COMMAND's function definition and its value.
1685 If a second optional argument MAPVAR is given, the map is stored as
1686 its value instead of as COMMAND's value; but COMMAND is still defined
1688 The third optional argument NAME, if given, supplies a menu name
1689 string for the map. This is required to use the keymap as a menu.
1690 This function returns COMMAND. */)
1691 (command
, mapvar
, name
)
1692 Lisp_Object command
, mapvar
, name
;
1695 map
= Fmake_sparse_keymap (name
);
1696 Ffset (command
, map
);
1700 Fset (command
, map
);
1704 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1705 doc
: /* Select KEYMAP as the global keymap. */)
1709 keymap
= get_keymap (keymap
, 1, 1);
1710 current_global_map
= keymap
;
1715 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1716 doc
: /* Select KEYMAP as the local keymap.
1717 If KEYMAP is nil, that means no local keymap. */)
1722 keymap
= get_keymap (keymap
, 1, 1);
1724 current_buffer
->keymap
= keymap
;
1729 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1730 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1733 return current_buffer
->keymap
;
1736 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1737 doc
: /* Return the current global keymap. */)
1740 return current_global_map
;
1743 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1744 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1748 int nmaps
= current_minor_maps (0, &maps
);
1750 return Flist (nmaps
, maps
);
1753 /* Help functions for describing and documenting keymaps. */
1757 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1758 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1759 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1763 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1767 /* Look for and break cycles. */
1768 while (!NILP (tem
= Frassq (cmd
, maps
)))
1770 Lisp_Object prefix
= XCAR (tem
);
1771 int lim
= XINT (Flength (XCAR (tem
)));
1772 if (lim
<= XINT (Flength (thisseq
)))
1773 { /* This keymap was already seen with a smaller prefix. */
1775 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1776 Faref (thisseq
, make_number (i
))))
1779 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1782 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1783 but maybe `cmd' occurs again further down in `maps', so keep
1785 maps
= XCDR (Fmemq (tem
, maps
));
1788 /* If the last key in thisseq is meta-prefix-char,
1789 turn it into a meta-ized keystroke. We know
1790 that the event we're about to append is an
1791 ascii keystroke since we're processing a
1795 int meta_bit
= meta_modifier
;
1796 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1797 tem
= Fcopy_sequence (thisseq
);
1799 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1801 /* This new sequence is the same length as
1802 thisseq, so stick it in the list right
1805 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1809 tem
= append_key (thisseq
, key
);
1810 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1815 accessible_keymaps_char_table (args
, index
, cmd
)
1816 Lisp_Object args
, index
, cmd
;
1818 accessible_keymaps_1 (index
, cmd
,
1822 XINT (XCDR (XCAR (args
))));
1825 /* This function cannot GC. */
1827 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1829 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1830 Returns a list of elements of the form (KEYS . MAP), where the sequence
1831 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1832 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1833 An optional argument PREFIX, if non-nil, should be a key sequence;
1834 then the value includes only maps for prefixes that start with PREFIX. */)
1836 Lisp_Object keymap
, prefix
;
1838 Lisp_Object maps
, tail
;
1841 /* no need for gcpro because we don't autoload any keymaps. */
1844 prefixlen
= XINT (Flength (prefix
));
1848 /* If a prefix was specified, start with the keymap (if any) for
1849 that prefix, so we don't waste time considering other prefixes. */
1851 tem
= Flookup_key (keymap
, prefix
, Qt
);
1852 /* Flookup_key may give us nil, or a number,
1853 if the prefix is not defined in this particular map.
1854 It might even give us a list that isn't a keymap. */
1855 tem
= get_keymap (tem
, 0, 0);
1858 /* Convert PREFIX to a vector now, so that later on
1859 we don't have to deal with the possibility of a string. */
1860 if (STRINGP (prefix
))
1865 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1866 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1870 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1871 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1872 c
^= 0200 | meta_modifier
;
1873 ASET (copy
, i_before
, make_number (c
));
1877 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1883 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1884 get_keymap (keymap
, 1, 0)),
1887 /* For each map in the list maps,
1888 look at any other maps it points to,
1889 and stick them at the end if they are not already in the list.
1891 This is a breadth-first traversal, where tail is the queue of
1892 nodes, and maps accumulates a list of all nodes visited. */
1894 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1896 register Lisp_Object thisseq
, thismap
;
1898 /* Does the current sequence end in the meta-prefix-char? */
1901 thisseq
= Fcar (Fcar (tail
));
1902 thismap
= Fcdr (Fcar (tail
));
1903 last
= make_number (XINT (Flength (thisseq
)) - 1);
1904 is_metized
= (XINT (last
) >= 0
1905 /* Don't metize the last char of PREFIX. */
1906 && XINT (last
) >= prefixlen
1907 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1909 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1913 elt
= XCAR (thismap
);
1917 if (CHAR_TABLE_P (elt
))
1919 Lisp_Object indices
[3];
1921 map_char_table (accessible_keymaps_char_table
, Qnil
, elt
,
1922 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1923 Fcons (tail
, thisseq
)),
1926 else if (VECTORP (elt
))
1930 /* Vector keymap. Scan all the elements. */
1931 for (i
= 0; i
< ASIZE (elt
); i
++)
1932 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1933 maps
, tail
, thisseq
, is_metized
);
1936 else if (CONSP (elt
))
1937 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1938 maps
, tail
, thisseq
,
1939 is_metized
&& INTEGERP (XCAR (elt
)));
1947 Lisp_Object Qsingle_key_description
, Qkey_description
;
1949 /* This function cannot GC. */
1951 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
1952 doc
: /* Return a pretty description of key-sequence KEYS.
1953 Optional arg PREFIX is the sequence of keys leading up to KEYS.
1954 Control characters turn into "C-foo" sequences, meta into "M-foo",
1955 spaces are put between sequence elements, etc. */)
1957 Lisp_Object keys
, prefix
;
1962 int size
= XINT (Flength (keys
));
1964 Lisp_Object sep
= build_string (" ");
1969 size
+= XINT (Flength (prefix
));
1971 /* This has one extra element at the end that we don't pass to Fconcat. */
1972 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
1974 /* In effect, this computes
1975 (mapconcat 'single-key-description keys " ")
1976 but we shouldn't use mapconcat because it can do GC. */
1980 list
= prefix
, prefix
= Qnil
;
1981 else if (!NILP (keys
))
1982 list
= keys
, keys
= Qnil
;
1987 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
1991 return empty_string
;
1992 return Fconcat (len
- 1, args
);
1996 size
= SCHARS (list
);
1997 else if (VECTORP (list
))
1998 size
= XVECTOR (list
)->size
;
1999 else if (CONSP (list
))
2000 size
= XINT (Flength (list
));
2002 wrong_type_argument (Qarrayp
, list
);
2011 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2012 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2013 c
^= 0200 | meta_modifier
;
2014 XSETFASTINT (key
, c
);
2016 else if (VECTORP (list
))
2018 key
= AREF (list
, i
++);
2030 || EQ (key
, meta_prefix_char
)
2031 || (XINT (key
) & meta_modifier
))
2033 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2035 if (EQ (key
, meta_prefix_char
))
2039 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2042 else if (EQ (key
, meta_prefix_char
))
2047 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2055 push_key_description (c
, p
, force_multibyte
)
2056 register unsigned int c
;
2058 int force_multibyte
;
2062 /* Clear all the meaningless bits above the meta bit. */
2063 c
&= meta_modifier
| ~ - meta_modifier
;
2064 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2065 | meta_modifier
| shift_modifier
| super_modifier
);
2067 if (c
& alt_modifier
)
2073 if ((c
& ctrl_modifier
) != 0
2074 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2078 c
&= ~ctrl_modifier
;
2080 if (c
& hyper_modifier
)
2084 c
-= hyper_modifier
;
2086 if (c
& meta_modifier
)
2092 if (c
& shift_modifier
)
2096 c
-= shift_modifier
;
2098 if (c
& super_modifier
)
2102 c
-= super_modifier
;
2118 else if (c
== Ctl ('M'))
2126 /* `C-' already added above. */
2127 if (c
> 0 && c
<= Ctl ('Z'))
2146 || (NILP (current_buffer
->enable_multibyte_characters
)
2147 && SINGLE_BYTE_CHAR_P (c
)
2148 && !force_multibyte
))
2154 int valid_p
= SINGLE_BYTE_CHAR_P (c
) || char_valid_p (c
, 0);
2156 if (force_multibyte
&& valid_p
)
2158 if (SINGLE_BYTE_CHAR_P (c
))
2159 c
= unibyte_char_to_multibyte (c
);
2160 p
+= CHAR_STRING (c
, p
);
2162 else if (NILP (current_buffer
->enable_multibyte_characters
)
2167 /* The biggest character code uses 19 bits. */
2168 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
2170 if (c
>= (1 << bit_offset
))
2171 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2175 p
+= CHAR_STRING (c
, p
);
2181 /* This function cannot GC. */
2183 DEFUN ("single-key-description", Fsingle_key_description
,
2184 Ssingle_key_description
, 1, 2, 0,
2185 doc
: /* Return a pretty description of command character KEY.
2186 Control characters turn into C-whatever, etc.
2187 Optional argument NO-ANGLES non-nil means don't put angle brackets
2188 around function keys and event symbols. */)
2190 Lisp_Object key
, no_angles
;
2192 if (CONSP (key
) && lucid_event_type_list_p (key
))
2193 key
= Fevent_convert_list (key
);
2195 key
= EVENT_HEAD (key
);
2197 if (INTEGERP (key
)) /* Normal character */
2199 unsigned int charset
, c1
, c2
;
2200 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
2202 if (SINGLE_BYTE_CHAR_P (without_bits
))
2205 SPLIT_CHAR (without_bits
, charset
, c1
, c2
);
2208 && CHARSET_DEFINED_P (charset
)
2209 && ((c1
>= 0 && c1
< 32)
2210 || (c2
>= 0 && c2
< 32)))
2212 /* Handle a generic character. */
2214 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
2215 CHECK_STRING (name
);
2216 return concat2 (build_string ("Character set "), name
);
2220 char tem
[KEY_DESCRIPTION_SIZE
], *end
;
2224 end
= push_key_description (XUINT (key
), tem
, 1);
2226 nchars
= multibyte_chars_in_text (tem
, nbytes
);
2227 if (nchars
== nbytes
)
2230 string
= build_string (tem
);
2233 string
= make_multibyte_string (tem
, nchars
, nbytes
);
2237 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2239 if (NILP (no_angles
))
2242 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2243 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2244 return build_string (buffer
);
2247 return Fsymbol_name (key
);
2249 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2250 return Fcopy_sequence (key
);
2252 error ("KEY must be an integer, cons, symbol, or string");
2257 push_text_char_description (c
, p
)
2258 register unsigned int c
;
2270 *p
++ = c
+ 64; /* 'A' - 1 */
2282 /* This function cannot GC. */
2284 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2285 doc
: /* Return a pretty description of file-character CHARACTER.
2286 Control characters turn into "^char", etc. This differs from
2287 `single-key-description' which turns them into "C-char".
2288 Also, this function recognizes the 2**7 bit as the Meta character,
2289 whereas `single-key-description' uses the 2**27 bit for Meta.
2290 See Info node `(elisp)Describing Characters' for examples. */)
2292 Lisp_Object character
;
2294 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2295 unsigned char str
[6];
2298 CHECK_NUMBER (character
);
2300 c
= XINT (character
);
2301 if (!SINGLE_BYTE_CHAR_P (c
))
2303 int len
= CHAR_STRING (c
, str
);
2305 return make_multibyte_string (str
, 1, len
);
2308 *push_text_char_description (c
& 0377, str
) = 0;
2310 return build_string (str
);
2313 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2316 ascii_sequence_p (seq
)
2320 int len
= XINT (Flength (seq
));
2322 for (i
= 0; i
< len
; i
++)
2324 Lisp_Object ii
, elt
;
2326 XSETFASTINT (ii
, i
);
2327 elt
= Faref (seq
, ii
);
2330 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2338 /* where-is - finding a command in a set of keymaps. */
2340 static Lisp_Object
where_is_internal ();
2341 static Lisp_Object
where_is_internal_1 ();
2342 static void where_is_internal_2 ();
2344 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2345 Returns the first non-nil binding found in any of those maps. */
2348 shadow_lookup (shadow
, key
, flag
)
2349 Lisp_Object shadow
, key
, flag
;
2351 Lisp_Object tail
, value
;
2353 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2355 value
= Flookup_key (XCAR (tail
), key
, flag
);
2356 if (!NILP (value
) && !NATNUMP (value
))
2362 static Lisp_Object Vmouse_events
;
2364 /* This function can GC if Flookup_key autoloads any keymaps. */
2367 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2368 Lisp_Object definition
, keymaps
;
2369 Lisp_Object firstonly
, noindirect
, no_remap
;
2371 Lisp_Object maps
= Qnil
;
2372 Lisp_Object found
, sequences
;
2373 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2374 /* 1 means ignore all menu bindings entirely. */
2375 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2377 /* If this command is remapped, then it has no key bindings
2379 if (NILP (no_remap
) && SYMBOLP (definition
))
2382 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2387 while (CONSP (found
))
2391 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2392 found
= XCDR (found
);
2395 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2399 for (; !NILP (maps
); maps
= Fcdr (maps
))
2401 /* Key sequence to reach map, and the map that it reaches */
2402 register Lisp_Object
this, map
, tem
;
2404 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2405 [M-CHAR] sequences, check if last character of the sequence
2406 is the meta-prefix char. */
2410 this = Fcar (Fcar (maps
));
2411 map
= Fcdr (Fcar (maps
));
2412 last
= make_number (XINT (Flength (this)) - 1);
2413 last_is_meta
= (XINT (last
) >= 0
2414 && EQ (Faref (this, last
), meta_prefix_char
));
2416 /* if (nomenus && !ascii_sequence_p (this)) */
2417 if (nomenus
&& XINT (last
) >= 0
2418 && SYMBOLP (tem
= Faref (this, make_number (0)))
2419 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2420 /* If no menu entries should be returned, skip over the
2421 keymaps bound to `menu-bar' and `tool-bar' and other
2422 non-ascii prefixes like `C-down-mouse-2'. */
2429 /* Because the code we want to run on each binding is rather
2430 large, we don't want to have two separate loop bodies for
2431 sparse keymap bindings and tables; we want to iterate one
2432 loop body over both keymap and vector bindings.
2434 For this reason, if Fcar (map) is a vector, we don't
2435 advance map to the next element until i indicates that we
2436 have finished off the vector. */
2437 Lisp_Object elt
, key
, binding
;
2445 /* Set key and binding to the current key and binding, and
2446 advance map and i to the next binding. */
2449 Lisp_Object sequence
;
2451 /* In a vector, look at each element. */
2452 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2454 binding
= AREF (elt
, i
);
2455 XSETFASTINT (key
, i
);
2456 sequence
= where_is_internal_1 (binding
, key
, definition
,
2458 last
, nomenus
, last_is_meta
);
2459 if (!NILP (sequence
))
2460 sequences
= Fcons (sequence
, sequences
);
2463 else if (CHAR_TABLE_P (elt
))
2465 Lisp_Object indices
[3];
2468 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2469 Qnil
), /* Result accumulator. */
2470 Fcons (Fcons (this, last
),
2471 Fcons (make_number (nomenus
),
2472 make_number (last_is_meta
))));
2473 map_char_table (where_is_internal_2
, Qnil
, elt
, elt
, args
,
2475 sequences
= XCDR (XCAR (args
));
2477 else if (CONSP (elt
))
2479 Lisp_Object sequence
;
2482 binding
= XCDR (elt
);
2484 sequence
= where_is_internal_1 (binding
, key
, definition
,
2486 last
, nomenus
, last_is_meta
);
2487 if (!NILP (sequence
))
2488 sequences
= Fcons (sequence
, sequences
);
2492 while (!NILP (sequences
))
2494 Lisp_Object sequence
, remapped
, function
;
2496 sequence
= XCAR (sequences
);
2497 sequences
= XCDR (sequences
);
2499 /* If the current sequence is a command remapping with
2500 format [remap COMMAND], find the key sequences
2501 which run COMMAND, and use those sequences instead. */
2504 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2505 && EQ (AREF (sequence
, 0), Qremap
)
2506 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2508 Lisp_Object remapped1
;
2510 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2511 if (CONSP (remapped1
))
2513 /* Verify that this key binding actually maps to the
2514 remapped command (see below). */
2515 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2517 sequence
= XCAR (remapped1
);
2518 remapped
= XCDR (remapped1
);
2519 goto record_sequence
;
2523 /* Verify that this key binding is not shadowed by another
2524 binding for the same key, before we say it exists.
2526 Mechanism: look for local definition of this key and if
2527 it is defined and does not match what we found then
2530 Either nil or number as value from Flookup_key
2532 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2536 /* It is a true unshadowed match. Record it, unless it's already
2537 been seen (as could happen when inheriting keymaps). */
2538 if (NILP (Fmember (sequence
, found
)))
2539 found
= Fcons (sequence
, found
);
2541 /* If firstonly is Qnon_ascii, then we can return the first
2542 binding we find. If firstonly is not Qnon_ascii but not
2543 nil, then we should return the first ascii-only binding
2545 if (EQ (firstonly
, Qnon_ascii
))
2546 RETURN_UNGCPRO (sequence
);
2547 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2548 RETURN_UNGCPRO (sequence
);
2550 if (CONSP (remapped
))
2552 sequence
= XCAR (remapped
);
2553 remapped
= XCDR (remapped
);
2554 goto record_sequence
;
2562 found
= Fnreverse (found
);
2564 /* firstonly may have been t, but we may have gone all the way through
2565 the keymaps without finding an all-ASCII key sequence. So just
2566 return the best we could find. */
2567 if (!NILP (firstonly
))
2568 return Fcar (found
);
2573 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2574 doc
: /* Return list of keys that invoke DEFINITION.
2575 If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2576 If KEYMAP is nil, search all the currently active keymaps.
2577 If KEYMAP is a list of keymaps, search only those keymaps.
2579 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2580 rather than a list of all possible key sequences.
2581 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2582 no matter what it is.
2583 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
2584 and entirely reject menu bindings.
2586 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2587 to other keymaps or slots. This makes it possible to search for an
2588 indirect definition itself.
2590 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2591 that invoke a command which is remapped to DEFINITION, but include the
2592 remapped command in the returned list. */)
2593 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2594 Lisp_Object definition
, keymap
;
2595 Lisp_Object firstonly
, noindirect
, no_remap
;
2597 Lisp_Object sequences
, keymaps
;
2598 /* 1 means ignore all menu bindings entirely. */
2599 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2602 /* Find the relevant keymaps. */
2603 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2605 else if (!NILP (keymap
))
2606 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2608 keymaps
= Fcurrent_active_maps (Qnil
);
2610 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2611 We don't really need to check `keymap'. */
2612 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2616 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2618 /* Check heuristic-consistency of the cache. */
2619 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2620 where_is_cache
= Qnil
;
2622 if (NILP (where_is_cache
))
2624 /* We need to create the cache. */
2625 Lisp_Object args
[2];
2626 where_is_cache
= Fmake_hash_table (0, args
);
2627 where_is_cache_keymaps
= Qt
;
2629 /* Fill in the cache. */
2630 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2631 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2634 where_is_cache_keymaps
= keymaps
;
2637 /* We want to process definitions from the last to the first.
2638 Instead of consing, copy definitions to a vector and step
2639 over that vector. */
2640 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2641 n
= XINT (Flength (sequences
));
2642 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2643 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2644 defns
[i
++] = XCAR (sequences
);
2646 /* Verify that the key bindings are not shadowed. Note that
2647 the following can GC. */
2648 GCPRO2 (definition
, keymaps
);
2651 for (i
= n
- 1; i
>= 0; --i
)
2652 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2654 if (ascii_sequence_p (defns
[i
]))
2660 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2665 /* Kill the cache so that where_is_internal_1 doesn't think
2666 we're filling it up. */
2667 where_is_cache
= Qnil
;
2668 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2674 /* This is the function that Fwhere_is_internal calls using map_char_table.
2676 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2678 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2679 Since map_char_table doesn't really use the return value from this function,
2680 we the result append to RESULT, the slot in ARGS.
2682 This function can GC because it calls where_is_internal_1 which can
2686 where_is_internal_2 (args
, key
, binding
)
2687 Lisp_Object args
, key
, binding
;
2689 Lisp_Object definition
, noindirect
, this, last
;
2690 Lisp_Object result
, sequence
;
2691 int nomenus
, last_is_meta
;
2692 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2694 GCPRO3 (args
, key
, binding
);
2695 result
= XCDR (XCAR (args
));
2696 definition
= XCAR (XCAR (XCAR (args
)));
2697 noindirect
= XCDR (XCAR (XCAR (args
)));
2698 this = XCAR (XCAR (XCDR (args
)));
2699 last
= XCDR (XCAR (XCDR (args
)));
2700 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2701 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2703 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2704 this, last
, nomenus
, last_is_meta
);
2706 if (!NILP (sequence
))
2707 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2713 /* This function cannot GC. */
2716 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2717 nomenus
, last_is_meta
)
2718 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2719 int nomenus
, last_is_meta
;
2721 Lisp_Object sequence
;
2723 /* Search through indirections unless that's not wanted. */
2724 if (NILP (noindirect
))
2725 binding
= get_keyelt (binding
, 0);
2727 /* End this iteration if this element does not match
2730 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2731 || EQ (binding
, definition
)
2732 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2733 /* Doesn't match. */
2736 /* We have found a match. Construct the key sequence where we found it. */
2737 if (INTEGERP (key
) && last_is_meta
)
2739 sequence
= Fcopy_sequence (this);
2740 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2743 sequence
= append_key (this, key
);
2745 if (!NILP (where_is_cache
))
2747 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2748 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2755 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2757 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2758 doc
: /* Insert the list of all defined keys and their definitions.
2759 The list is inserted in the current buffer, while the bindings are
2760 looked up in BUFFER.
2761 The optional argument PREFIX, if non-nil, should be a key sequence;
2762 then we display only bindings that start with that prefix.
2763 The optional argument MENUS, if non-nil, says to mention menu bindings.
2764 \(Ordinarily these are omitted from the output.) */)
2765 (buffer
, prefix
, menus
)
2766 Lisp_Object buffer
, prefix
, menus
;
2768 Lisp_Object outbuf
, shadow
;
2769 int nomenu
= NILP (menus
);
2770 register Lisp_Object start1
;
2771 struct gcpro gcpro1
;
2773 char *alternate_heading
2775 Keyboard translations:\n\n\
2776 You type Translation\n\
2777 -------- -----------\n";
2782 outbuf
= Fcurrent_buffer ();
2784 /* Report on alternates for keys. */
2785 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2788 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2789 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2791 for (c
= 0; c
< translate_len
; c
++)
2792 if (translate
[c
] != c
)
2794 char buf
[KEY_DESCRIPTION_SIZE
];
2797 if (alternate_heading
)
2799 insert_string (alternate_heading
);
2800 alternate_heading
= 0;
2803 bufend
= push_key_description (translate
[c
], buf
, 1);
2804 insert (buf
, bufend
- buf
);
2805 Findent_to (make_number (16), make_number (1));
2806 bufend
= push_key_description (c
, buf
, 1);
2807 insert (buf
, bufend
- buf
);
2815 if (!NILP (Vkey_translation_map
))
2816 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2817 "Key translations", nomenu
, 1, 0);
2820 /* Print the (major mode) local map. */
2822 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2823 start1
= current_kboard
->Voverriding_terminal_local_map
;
2824 else if (!NILP (Voverriding_local_map
))
2825 start1
= Voverriding_local_map
;
2829 describe_map_tree (start1
, 1, shadow
, prefix
,
2830 "\f\nOverriding Bindings", nomenu
, 0, 0);
2831 shadow
= Fcons (start1
, shadow
);
2835 /* Print the minor mode and major mode keymaps. */
2837 Lisp_Object
*modes
, *maps
;
2839 /* Temporarily switch to `buffer', so that we can get that buffer's
2840 minor modes correctly. */
2841 Fset_buffer (buffer
);
2843 nmaps
= current_minor_maps (&modes
, &maps
);
2844 Fset_buffer (outbuf
);
2846 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2847 XBUFFER (buffer
), Qkeymap
);
2850 describe_map_tree (start1
, 1, shadow
, prefix
,
2851 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2852 shadow
= Fcons (start1
, shadow
);
2855 /* Print the minor mode maps. */
2856 for (i
= 0; i
< nmaps
; i
++)
2858 /* The title for a minor mode keymap
2859 is constructed at run time.
2860 We let describe_map_tree do the actual insertion
2861 because it takes care of other features when doing so. */
2864 if (!SYMBOLP (modes
[i
]))
2867 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2871 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2872 SCHARS (SYMBOL_NAME (modes
[i
])));
2873 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2875 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2876 p
+= sizeof (" Minor Mode Bindings") - 1;
2879 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2880 shadow
= Fcons (maps
[i
], shadow
);
2883 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2884 XBUFFER (buffer
), Qlocal_map
);
2887 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2888 describe_map_tree (start1
, 1, shadow
, prefix
,
2889 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2891 describe_map_tree (start1
, 1, shadow
, prefix
,
2892 "\f\n`local-map' Property Bindings",
2895 shadow
= Fcons (start1
, shadow
);
2899 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2900 "\f\nGlobal Bindings", nomenu
, 0, 1);
2902 /* Print the function-key-map translations under this prefix. */
2903 if (!NILP (Vfunction_key_map
))
2904 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2905 "\f\nFunction key map translations", nomenu
, 1, 0);
2911 /* Insert a description of the key bindings in STARTMAP,
2912 followed by those of all maps reachable through STARTMAP.
2913 If PARTIAL is nonzero, omit certain "uninteresting" commands
2914 (such as `undefined').
2915 If SHADOW is non-nil, it is a list of maps;
2916 don't mention keys which would be shadowed by any of them.
2917 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2918 TITLE, if not 0, is a string to insert at the beginning.
2919 TITLE should not end with a colon or a newline; we supply that.
2920 If NOMENU is not 0, then omit menu-bar commands.
2922 If TRANSL is nonzero, the definitions are actually key translations
2923 so print strings and vectors differently.
2925 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2929 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2931 Lisp_Object startmap
, shadow
, prefix
;
2938 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2939 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2946 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2949 GCPRO3 (maps
, seen
, sub_shadows
);
2955 /* Delete from MAPS each element that is for the menu bar. */
2956 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2958 Lisp_Object elt
, prefix
, tem
;
2961 prefix
= Fcar (elt
);
2962 if (XVECTOR (prefix
)->size
>= 1)
2964 tem
= Faref (prefix
, make_number (0));
2965 if (EQ (tem
, Qmenu_bar
))
2966 maps
= Fdelq (elt
, maps
);
2971 if (!NILP (maps
) || always_title
)
2975 insert_string (title
);
2978 insert_string (" Starting With ");
2979 insert1 (Fkey_description (prefix
, Qnil
));
2981 insert_string (":\n");
2983 insert_string (key_heading
);
2987 for (; !NILP (maps
); maps
= Fcdr (maps
))
2989 register Lisp_Object elt
, prefix
, tail
;
2992 prefix
= Fcar (elt
);
2996 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
3000 shmap
= XCAR (tail
);
3002 /* If the sequence by which we reach this keymap is zero-length,
3003 then the shadow map for this keymap is just SHADOW. */
3004 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
3005 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3007 /* If the sequence by which we reach this keymap actually has
3008 some elements, then the sequence's definition in SHADOW is
3009 what we should use. */
3012 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3013 if (INTEGERP (shmap
))
3017 /* If shmap is not nil and not a keymap,
3018 it completely shadows this map, so don't
3019 describe this map at all. */
3020 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3024 sub_shadows
= Fcons (shmap
, sub_shadows
);
3027 /* Maps we have already listed in this loop shadow this map. */
3028 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3031 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3033 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3036 describe_map (Fcdr (elt
), prefix
,
3037 transl
? describe_translation
: describe_command
,
3038 partial
, sub_shadows
, &seen
, nomenu
);
3044 insert_string ("\n");
3049 static int previous_description_column
;
3052 describe_command (definition
, args
)
3053 Lisp_Object definition
, args
;
3055 register Lisp_Object tem1
;
3056 int column
= (int) current_column (); /* iftc */
3057 int description_column
;
3059 /* If column 16 is no good, go to col 32;
3060 but don't push beyond that--go to next line instead. */
3064 description_column
= 32;
3066 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3067 description_column
= 32;
3069 description_column
= 16;
3071 Findent_to (make_number (description_column
), make_number (1));
3072 previous_description_column
= description_column
;
3074 if (SYMBOLP (definition
))
3076 tem1
= SYMBOL_NAME (definition
);
3078 insert_string ("\n");
3080 else if (STRINGP (definition
) || VECTORP (definition
))
3081 insert_string ("Keyboard Macro\n");
3082 else if (KEYMAPP (definition
))
3083 insert_string ("Prefix Command\n");
3085 insert_string ("??\n");
3089 describe_translation (definition
, args
)
3090 Lisp_Object definition
, args
;
3092 register Lisp_Object tem1
;
3094 Findent_to (make_number (16), make_number (1));
3096 if (SYMBOLP (definition
))
3098 tem1
= SYMBOL_NAME (definition
);
3100 insert_string ("\n");
3102 else if (STRINGP (definition
) || VECTORP (definition
))
3104 insert1 (Fkey_description (definition
, Qnil
));
3105 insert_string ("\n");
3107 else if (KEYMAPP (definition
))
3108 insert_string ("Prefix Command\n");
3110 insert_string ("??\n");
3113 /* Describe the contents of map MAP, assuming that this map itself is
3114 reached by the sequence of prefix keys PREFIX (a string or vector).
3115 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3118 describe_map (map
, prefix
, elt_describer
, partial
, shadow
, seen
, nomenu
)
3119 register Lisp_Object map
;
3121 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3127 Lisp_Object tail
, definition
, event
;
3129 Lisp_Object suppress
;
3132 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3137 suppress
= intern ("suppress-keymap");
3139 /* This vector gets used to present single keys to Flookup_key. Since
3140 that is done once per keymap element, we don't want to cons up a
3141 fresh vector every time. */
3142 kludge
= Fmake_vector (make_number (1), Qnil
);
3145 GCPRO3 (prefix
, definition
, kludge
);
3147 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3151 if (VECTORP (XCAR (tail
))
3152 || CHAR_TABLE_P (XCAR (tail
)))
3153 describe_vector (XCAR (tail
),
3154 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3156 else if (CONSP (XCAR (tail
)))
3158 event
= XCAR (XCAR (tail
));
3160 /* Ignore bindings whose "prefix" are not really valid events.
3161 (We get these in the frames and buffers menu.) */
3162 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3165 if (nomenu
&& EQ (event
, Qmenu_bar
))
3168 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3170 /* Don't show undefined commands or suppressed commands. */
3171 if (NILP (definition
)) continue;
3172 if (SYMBOLP (definition
) && partial
)
3174 tem
= Fget (definition
, suppress
);
3179 /* Don't show a command that isn't really visible
3180 because a local definition of the same key shadows it. */
3182 ASET (kludge
, 0, event
);
3185 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3186 if (!NILP (tem
)) continue;
3189 tem
= Flookup_key (map
, kludge
, Qt
);
3190 if (!EQ (tem
, definition
)) continue;
3194 previous_description_column
= 0;
3199 /* THIS gets the string to describe the character EVENT. */
3200 insert1 (Fkey_description (kludge
, prefix
));
3202 /* Print a description of the definition of this character.
3203 elt_describer will take care of spacing out far enough
3204 for alignment purposes. */
3205 (*elt_describer
) (definition
, Qnil
);
3207 else if (EQ (XCAR (tail
), Qkeymap
))
3209 /* The same keymap might be in the structure twice, if we're
3210 using an inherited keymap. So skip anything we've already
3212 tem
= Fassq (tail
, *seen
);
3213 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3215 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3223 describe_vector_princ (elt
, fun
)
3224 Lisp_Object elt
, fun
;
3226 Findent_to (make_number (16), make_number (1));
3231 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3232 doc
: /* Insert a description of contents of VECTOR.
3233 This is text showing the elements of vector matched against indices.
3234 DESCRIBER is the output function used; nil means use `princ'. */)
3236 Lisp_Object vector
, describer
;
3238 int count
= SPECPDL_INDEX ();
3239 if (NILP (describer
))
3240 describer
= intern ("princ");
3241 specbind (Qstandard_output
, Fcurrent_buffer ());
3242 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3243 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3244 Qnil
, Qnil
, (int *)0, 0, 0);
3246 return unbind_to (count
, Qnil
);
3249 /* Insert in the current buffer a description of the contents of VECTOR.
3250 We call ELT_DESCRIBER to insert the description of one value found
3253 ELT_PREFIX describes what "comes before" the keys or indices defined
3254 by this vector. This is a human-readable string whose size
3255 is not necessarily related to the situation.
3257 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3258 leads to this keymap.
3260 If the vector is a chartable, ELT_PREFIX is the vector
3261 of bytes that lead to the character set or portion of a character
3262 set described by this chartable.
3264 If PARTIAL is nonzero, it means do not mention suppressed commands
3265 (that assumes the vector is in a keymap).
3267 SHADOW is a list of keymaps that shadow this map.
3268 If it is non-nil, then we look up the key in those maps
3269 and we don't mention it now if it is defined by any of them.
3271 ENTIRE_MAP is the keymap in which this vector appears.
3272 If the definition in effect in the whole map does not match
3273 the one in this vector, we ignore this one.
3275 When describing a sub-char-table, INDICES is a list of
3276 indices at higher levels in this char-table,
3277 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3279 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3281 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3284 describe_vector (vector
, prefix
, args
, elt_describer
,
3285 partial
, shadow
, entire_map
,
3286 indices
, char_table_depth
, keymap_p
)
3287 register Lisp_Object vector
;
3288 Lisp_Object prefix
, args
;
3289 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3292 Lisp_Object entire_map
;
3294 int char_table_depth
;
3297 Lisp_Object definition
;
3299 Lisp_Object elt_prefix
= Qnil
;
3301 Lisp_Object suppress
;
3304 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3305 /* Range of elements to be handled. */
3307 /* A flag to tell if a leaf in this level of char-table is not a
3308 generic character (i.e. a complete multibyte character). */
3316 indices
= (int *) alloca (3 * sizeof (int));
3322 /* Call Fkey_description first, to avoid GC bug for the other string. */
3323 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3326 tem
= Fkey_description (prefix
, Qnil
);
3327 elt_prefix
= concat2 (tem
, build_string (" "));
3332 /* This vector gets used to present single keys to Flookup_key. Since
3333 that is done once per vector element, we don't want to cons up a
3334 fresh vector every time. */
3335 kludge
= Fmake_vector (make_number (1), Qnil
);
3336 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3339 suppress
= intern ("suppress-keymap");
3341 if (CHAR_TABLE_P (vector
))
3343 if (char_table_depth
== 0)
3345 /* VECTOR is a top level char-table. */
3348 to
= CHAR_TABLE_ORDINARY_SLOTS
;
3352 /* VECTOR is a sub char-table. */
3353 if (char_table_depth
>= 3)
3354 /* A char-table is never that deep. */
3355 error ("Too deep char table");
3358 = (CHARSET_VALID_P (indices
[0])
3359 && ((CHARSET_DIMENSION (indices
[0]) == 1
3360 && char_table_depth
== 1)
3361 || char_table_depth
== 2));
3363 /* Meaningful elements are from 32th to 127th. */
3365 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
3370 /* This does the right thing for ordinary vectors. */
3374 to
= XVECTOR (vector
)->size
;
3377 for (i
= from
; i
< to
; i
++)
3381 if (CHAR_TABLE_P (vector
))
3383 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3386 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3387 && !CHARSET_DEFINED_P (i
- 128))
3391 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3394 definition
= get_keyelt (AREF (vector
, i
), 0);
3396 if (NILP (definition
)) continue;
3398 /* Don't mention suppressed commands. */
3399 if (SYMBOLP (definition
) && partial
)
3403 tem
= Fget (definition
, suppress
);
3405 if (!NILP (tem
)) continue;
3408 /* Set CHARACTER to the character this entry describes, if any.
3409 Also update *INDICES. */
3410 if (CHAR_TABLE_P (vector
))
3412 indices
[char_table_depth
] = i
;
3414 if (char_table_depth
== 0)
3417 indices
[0] = i
- 128;
3419 else if (complete_char
)
3421 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3429 ASET (kludge
, 0, make_number (character
));
3431 /* If this binding is shadowed by some other map, ignore it. */
3432 if (!NILP (shadow
) && complete_char
)
3436 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3438 if (!NILP (tem
)) continue;
3441 /* Ignore this definition if it is shadowed by an earlier
3442 one in the same keymap. */
3443 if (!NILP (entire_map
) && complete_char
)
3447 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3449 if (!EQ (tem
, definition
))
3455 if (char_table_depth
== 0)
3460 /* For a sub char-table, show the depth by indentation.
3461 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3462 if (char_table_depth
> 0)
3463 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3465 /* Output the prefix that applies to every entry in this map. */
3466 if (!NILP (elt_prefix
))
3467 insert1 (elt_prefix
);
3469 /* Insert or describe the character this slot is for,
3470 or a description of what it is for. */
3471 if (SUB_CHAR_TABLE_P (vector
))
3474 insert_char (character
);
3477 /* We need an octal representation for this block of
3480 sprintf (work
, "(row %d)", i
);
3481 insert (work
, strlen (work
));
3484 else if (CHAR_TABLE_P (vector
))
3487 insert1 (Fkey_description (kludge
, prefix
));
3490 /* Print the information for this character set. */
3491 insert_string ("<");
3492 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3494 insert_from_string (tem2
, 0, 0, SCHARS (tem2
),
3503 insert1 (Fkey_description (kludge
, prefix
));
3506 /* If we find a sub char-table within a char-table,
3507 scan it recursively; it defines the details for
3508 a character set or a portion of a character set. */
3509 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3512 describe_vector (definition
, prefix
, args
, elt_describer
,
3513 partial
, shadow
, entire_map
,
3514 indices
, char_table_depth
+ 1, keymap_p
);
3520 /* Find all consecutive characters or rows that have the same
3521 definition. But, for elements of a top level char table, if
3522 they are for charsets, we had better describe one by one even
3523 if they have the same definition. */
3524 if (CHAR_TABLE_P (vector
))
3528 if (char_table_depth
== 0)
3529 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3531 while (i
+ 1 < limit
3532 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3534 && !NILP (Fequal (tem2
, definition
)))
3539 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3541 && !NILP (Fequal (tem2
, definition
)))
3545 /* If we have a range of more than one character,
3546 print where the range reaches to. */
3548 if (i
!= starting_i
)
3552 ASET (kludge
, 0, make_number (i
));
3554 if (!NILP (elt_prefix
))
3555 insert1 (elt_prefix
);
3557 if (CHAR_TABLE_P (vector
))
3559 if (char_table_depth
== 0)
3561 insert1 (Fkey_description (kludge
, prefix
));
3563 else if (complete_char
)
3565 indices
[char_table_depth
] = i
;
3566 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3567 insert_char (character
);
3571 /* We need an octal representation for this block of
3574 sprintf (work
, "(row %d)", i
);
3575 insert (work
, strlen (work
));
3580 insert1 (Fkey_description (kludge
, prefix
));
3584 /* Print a description of the definition of this character.
3585 elt_describer will take care of spacing out far enough
3586 for alignment purposes. */
3587 (*elt_describer
) (definition
, args
);
3590 /* For (sub) char-table, print `defalt' slot at last. */
3591 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3593 insert (" ", char_table_depth
* 2);
3594 insert_string ("<<default>>");
3595 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3601 /* Apropos - finding all symbols whose names match a regexp. */
3602 static Lisp_Object apropos_predicate
;
3603 static Lisp_Object apropos_accumulate
;
3606 apropos_accum (symbol
, string
)
3607 Lisp_Object symbol
, string
;
3609 register Lisp_Object tem
;
3611 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3612 if (!NILP (tem
) && !NILP (apropos_predicate
))
3613 tem
= call1 (apropos_predicate
, symbol
);
3615 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3618 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3619 doc
: /* Show all symbols whose names contain match for REGEXP.
3620 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3621 for each symbol and a symbol is mentioned only if that returns non-nil.
3622 Return list of symbols found. */)
3624 Lisp_Object regexp
, predicate
;
3627 CHECK_STRING (regexp
);
3628 apropos_predicate
= predicate
;
3629 apropos_accumulate
= Qnil
;
3630 map_obarray (Vobarray
, apropos_accum
, regexp
);
3631 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3632 apropos_accumulate
= Qnil
;
3633 apropos_predicate
= Qnil
;
3640 Qkeymap
= intern ("keymap");
3641 staticpro (&Qkeymap
);
3642 staticpro (&apropos_predicate
);
3643 staticpro (&apropos_accumulate
);
3644 apropos_predicate
= Qnil
;
3645 apropos_accumulate
= Qnil
;
3647 /* Now we are ready to set up this property, so we can
3648 create char tables. */
3649 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3651 /* Initialize the keymaps standardly used.
3652 Each one is the value of a Lisp variable, and is also
3653 pointed to by a C variable */
3655 global_map
= Fmake_keymap (Qnil
);
3656 Fset (intern ("global-map"), global_map
);
3658 current_global_map
= global_map
;
3659 staticpro (&global_map
);
3660 staticpro (¤t_global_map
);
3662 meta_map
= Fmake_keymap (Qnil
);
3663 Fset (intern ("esc-map"), meta_map
);
3664 Ffset (intern ("ESC-prefix"), meta_map
);
3666 control_x_map
= Fmake_keymap (Qnil
);
3667 Fset (intern ("ctl-x-map"), control_x_map
);
3668 Ffset (intern ("Control-X-prefix"), control_x_map
);
3671 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3672 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3673 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3674 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3675 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3677 staticpro (&exclude_keys
);
3679 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3680 doc
: /* List of commands given new key bindings recently.
3681 This is used for internal purposes during Emacs startup;
3682 don't alter it yourself. */);
3683 Vdefine_key_rebound_commands
= Qt
;
3685 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3686 doc
: /* Default keymap to use when reading from the minibuffer. */);
3687 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3689 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3690 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3691 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3692 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3694 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3695 doc
: /* Local keymap for minibuffer input with completion. */);
3696 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3697 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3699 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3700 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3701 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3702 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3703 Vminibuffer_local_completion_map
);
3705 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3706 doc
: /* Alist of keymaps to use for minor modes.
3707 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3708 key sequences and look up bindings iff VARIABLE's value is non-nil.
3709 If two active keymaps bind the same key, the keymap appearing earlier
3710 in the list takes precedence. */);
3711 Vminor_mode_map_alist
= Qnil
;
3713 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3714 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3715 This variable is an alist just like `minor-mode-map-alist', and it is
3716 used the same way (and before `minor-mode-map-alist'); however,
3717 it is provided for major modes to bind locally. */);
3718 Vminor_mode_overriding_map_alist
= Qnil
;
3720 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3721 doc
: /* List of keymap alists to use for emulations modes.
3722 It is intended for modes or packages using multiple minor-mode keymaps.
3723 Each element is a keymap alist just like `minor-mode-map-alist', or a
3724 symbol with a variable binding which is a keymap alist, and it is used
3725 the same way. The "active" keymaps in each alist are used before
3726 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3727 Vemulation_mode_map_alists
= Qnil
;
3730 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3731 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3732 This allows Emacs to recognize function keys sent from ASCII
3733 terminals at any point in a key sequence.
3735 The `read-key-sequence' function replaces any subsequence bound by
3736 `function-key-map' with its binding. More precisely, when the active
3737 keymaps have no binding for the current key sequence but
3738 `function-key-map' binds a suffix of the sequence to a vector or string,
3739 `read-key-sequence' replaces the matching suffix with its binding, and
3740 continues with the new sequence.
3742 The events that come from bindings in `function-key-map' are not
3743 themselves looked up in `function-key-map'.
3745 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3746 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3747 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3748 key, typing `ESC O P x' would return [f1 x]. */);
3749 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3751 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3752 doc
: /* Keymap of key translations that can override keymaps.
3753 This keymap works like `function-key-map', but comes after that,
3754 and its non-prefix bindings override ordinary bindings. */);
3755 Vkey_translation_map
= Qnil
;
3757 staticpro (&Vmouse_events
);
3758 Vmouse_events
= Fcons (intern ("menu-bar"),
3759 Fcons (intern ("tool-bar"),
3760 Fcons (intern ("header-line"),
3761 Fcons (intern ("mode-line"),
3762 Fcons (intern ("mouse-1"),
3763 Fcons (intern ("mouse-2"),
3764 Fcons (intern ("mouse-3"),
3765 Fcons (intern ("mouse-4"),
3766 Fcons (intern ("mouse-5"),
3770 Qsingle_key_description
= intern ("single-key-description");
3771 staticpro (&Qsingle_key_description
);
3773 Qkey_description
= intern ("key-description");
3774 staticpro (&Qkey_description
);
3776 Qkeymapp
= intern ("keymapp");
3777 staticpro (&Qkeymapp
);
3779 Qnon_ascii
= intern ("non-ascii");
3780 staticpro (&Qnon_ascii
);
3782 Qmenu_item
= intern ("menu-item");
3783 staticpro (&Qmenu_item
);
3785 Qremap
= intern ("remap");
3786 staticpro (&Qremap
);
3788 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3789 staticpro (&command_remapping_vector
);
3791 where_is_cache_keymaps
= Qt
;
3792 where_is_cache
= Qnil
;
3793 staticpro (&where_is_cache
);
3794 staticpro (&where_is_cache_keymaps
);
3796 defsubr (&Skeymapp
);
3797 defsubr (&Skeymap_parent
);
3798 defsubr (&Skeymap_prompt
);
3799 defsubr (&Sset_keymap_parent
);
3800 defsubr (&Smake_keymap
);
3801 defsubr (&Smake_sparse_keymap
);
3802 defsubr (&Smap_keymap
);
3803 defsubr (&Scopy_keymap
);
3804 defsubr (&Scommand_remapping
);
3805 defsubr (&Skey_binding
);
3806 defsubr (&Slocal_key_binding
);
3807 defsubr (&Sglobal_key_binding
);
3808 defsubr (&Sminor_mode_key_binding
);
3809 defsubr (&Sdefine_key
);
3810 defsubr (&Slookup_key
);
3811 defsubr (&Sdefine_prefix_command
);
3812 defsubr (&Suse_global_map
);
3813 defsubr (&Suse_local_map
);
3814 defsubr (&Scurrent_local_map
);
3815 defsubr (&Scurrent_global_map
);
3816 defsubr (&Scurrent_minor_mode_maps
);
3817 defsubr (&Scurrent_active_maps
);
3818 defsubr (&Saccessible_keymaps
);
3819 defsubr (&Skey_description
);
3820 defsubr (&Sdescribe_vector
);
3821 defsubr (&Ssingle_key_description
);
3822 defsubr (&Stext_char_description
);
3823 defsubr (&Swhere_is_internal
);
3824 defsubr (&Sdescribe_buffer_bindings
);
3825 defsubr (&Sapropos_internal
);
3831 initial_define_key (global_map
, 033, "ESC-prefix");
3832 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3835 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3836 (do not change this comment) */