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 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 (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
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, 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, 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 (command
, mapvar
, name
)
1691 Lisp_Object command
, mapvar
, name
;
1694 map
= Fmake_sparse_keymap (name
);
1695 Ffset (command
, map
);
1699 Fset (command
, map
);
1703 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1704 doc
: /* Select KEYMAP as the global keymap. */)
1708 keymap
= get_keymap (keymap
, 1, 1);
1709 current_global_map
= keymap
;
1714 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1715 doc
: /* Select KEYMAP as the local keymap.
1716 If KEYMAP is nil, that means no local keymap. */)
1721 keymap
= get_keymap (keymap
, 1, 1);
1723 current_buffer
->keymap
= keymap
;
1728 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1729 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1732 return current_buffer
->keymap
;
1735 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1736 doc
: /* Return the current global keymap. */)
1739 return current_global_map
;
1742 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1743 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1747 int nmaps
= current_minor_maps (0, &maps
);
1749 return Flist (nmaps
, maps
);
1752 /* Help functions for describing and documenting keymaps. */
1756 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1757 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1758 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1762 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1766 /* Look for and break cycles. */
1767 while (!NILP (tem
= Frassq (cmd
, maps
)))
1769 Lisp_Object prefix
= XCAR (tem
);
1770 int lim
= XINT (Flength (XCAR (tem
)));
1771 if (lim
<= XINT (Flength (thisseq
)))
1772 { /* This keymap was already seen with a smaller prefix. */
1774 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1775 Faref (thisseq
, make_number (i
))))
1778 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1781 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1782 but maybe `cmd' occurs again further down in `maps', so keep
1784 maps
= XCDR (Fmemq (tem
, maps
));
1787 /* If the last key in thisseq is meta-prefix-char,
1788 turn it into a meta-ized keystroke. We know
1789 that the event we're about to append is an
1790 ascii keystroke since we're processing a
1794 int meta_bit
= meta_modifier
;
1795 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1796 tem
= Fcopy_sequence (thisseq
);
1798 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1800 /* This new sequence is the same length as
1801 thisseq, so stick it in the list right
1804 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1808 tem
= append_key (thisseq
, key
);
1809 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1814 accessible_keymaps_char_table (args
, index
, cmd
)
1815 Lisp_Object args
, index
, cmd
;
1817 accessible_keymaps_1 (index
, cmd
,
1821 XINT (XCDR (XCAR (args
))));
1824 /* This function cannot GC. */
1826 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1828 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1829 Returns a list of elements of the form (KEYS . MAP), where the sequence
1830 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1831 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1832 An optional argument PREFIX, if non-nil, should be a key sequence;
1833 then the value includes only maps for prefixes that start with PREFIX. */)
1835 Lisp_Object keymap
, prefix
;
1837 Lisp_Object maps
, tail
;
1840 /* no need for gcpro because we don't autoload any keymaps. */
1843 prefixlen
= XINT (Flength (prefix
));
1847 /* If a prefix was specified, start with the keymap (if any) for
1848 that prefix, so we don't waste time considering other prefixes. */
1850 tem
= Flookup_key (keymap
, prefix
, Qt
);
1851 /* Flookup_key may give us nil, or a number,
1852 if the prefix is not defined in this particular map.
1853 It might even give us a list that isn't a keymap. */
1854 tem
= get_keymap (tem
, 0, 0);
1857 /* Convert PREFIX to a vector now, so that later on
1858 we don't have to deal with the possibility of a string. */
1859 if (STRINGP (prefix
))
1864 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1865 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1869 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1870 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1871 c
^= 0200 | meta_modifier
;
1872 ASET (copy
, i_before
, make_number (c
));
1876 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1882 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1883 get_keymap (keymap
, 1, 0)),
1886 /* For each map in the list maps,
1887 look at any other maps it points to,
1888 and stick them at the end if they are not already in the list.
1890 This is a breadth-first traversal, where tail is the queue of
1891 nodes, and maps accumulates a list of all nodes visited. */
1893 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1895 register Lisp_Object thisseq
, thismap
;
1897 /* Does the current sequence end in the meta-prefix-char? */
1900 thisseq
= Fcar (Fcar (tail
));
1901 thismap
= Fcdr (Fcar (tail
));
1902 last
= make_number (XINT (Flength (thisseq
)) - 1);
1903 is_metized
= (XINT (last
) >= 0
1904 /* Don't metize the last char of PREFIX. */
1905 && XINT (last
) >= prefixlen
1906 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1908 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1912 elt
= XCAR (thismap
);
1916 if (CHAR_TABLE_P (elt
))
1918 Lisp_Object indices
[3];
1920 map_char_table (accessible_keymaps_char_table
, Qnil
, elt
,
1921 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1922 Fcons (tail
, thisseq
)),
1925 else if (VECTORP (elt
))
1929 /* Vector keymap. Scan all the elements. */
1930 for (i
= 0; i
< ASIZE (elt
); i
++)
1931 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1932 maps
, tail
, thisseq
, is_metized
);
1935 else if (CONSP (elt
))
1936 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1937 maps
, tail
, thisseq
,
1938 is_metized
&& INTEGERP (XCAR (elt
)));
1946 Lisp_Object Qsingle_key_description
, Qkey_description
;
1948 /* This function cannot GC. */
1950 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
1951 doc
: /* Return a pretty description of key-sequence KEYS.
1952 Optional arg PREFIX is the sequence of keys leading up to KEYS.
1953 Control characters turn into "C-foo" sequences, meta into "M-foo"
1954 spaces are put between sequence elements, etc. */)
1956 Lisp_Object keys
, prefix
;
1961 int size
= XINT (Flength (keys
));
1963 Lisp_Object sep
= build_string (" ");
1968 size
+= XINT (Flength (prefix
));
1970 /* This has one extra element at the end that we don't pass to Fconcat. */
1971 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
1973 /* In effect, this computes
1974 (mapconcat 'single-key-description keys " ")
1975 but we shouldn't use mapconcat because it can do GC. */
1979 list
= prefix
, prefix
= Qnil
;
1980 else if (!NILP (keys
))
1981 list
= keys
, keys
= Qnil
;
1986 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
1990 return empty_string
;
1991 return Fconcat (len
- 1, args
);
1995 size
= SCHARS (list
);
1996 else if (VECTORP (list
))
1997 size
= XVECTOR (list
)->size
;
1998 else if (CONSP (list
))
1999 size
= XINT (Flength (list
));
2001 wrong_type_argument (Qarrayp
, list
);
2010 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2011 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2012 c
^= 0200 | meta_modifier
;
2013 XSETFASTINT (key
, c
);
2015 else if (VECTORP (list
))
2017 key
= AREF (list
, i
++);
2029 || EQ (key
, meta_prefix_char
)
2030 || (XINT (key
) & meta_modifier
))
2032 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2034 if (EQ (key
, meta_prefix_char
))
2038 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2041 else if (EQ (key
, meta_prefix_char
))
2046 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2054 push_key_description (c
, p
, force_multibyte
)
2055 register unsigned int c
;
2057 int force_multibyte
;
2061 /* Clear all the meaningless bits above the meta bit. */
2062 c
&= meta_modifier
| ~ - meta_modifier
;
2063 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2064 | meta_modifier
| shift_modifier
| super_modifier
);
2066 if (c
& alt_modifier
)
2072 if ((c
& ctrl_modifier
) != 0
2073 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2077 c
&= ~ctrl_modifier
;
2079 if (c
& hyper_modifier
)
2083 c
-= hyper_modifier
;
2085 if (c
& meta_modifier
)
2091 if (c
& shift_modifier
)
2095 c
-= shift_modifier
;
2097 if (c
& super_modifier
)
2101 c
-= super_modifier
;
2117 else if (c
== Ctl ('M'))
2125 /* `C-' already added above. */
2126 if (c
> 0 && c
<= Ctl ('Z'))
2145 || (NILP (current_buffer
->enable_multibyte_characters
)
2146 && SINGLE_BYTE_CHAR_P (c
)
2147 && !force_multibyte
))
2153 int valid_p
= SINGLE_BYTE_CHAR_P (c
) || char_valid_p (c
, 0);
2155 if (force_multibyte
&& valid_p
)
2157 if (SINGLE_BYTE_CHAR_P (c
))
2158 c
= unibyte_char_to_multibyte (c
);
2159 p
+= CHAR_STRING (c
, p
);
2161 else if (NILP (current_buffer
->enable_multibyte_characters
)
2166 /* The biggest character code uses 19 bits. */
2167 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
2169 if (c
>= (1 << bit_offset
))
2170 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2174 p
+= CHAR_STRING (c
, p
);
2180 /* This function cannot GC. */
2182 DEFUN ("single-key-description", Fsingle_key_description
,
2183 Ssingle_key_description
, 1, 2, 0,
2184 doc
: /* Return a pretty description of command character KEY.
2185 Control characters turn into C-whatever, etc.
2186 Optional argument NO-ANGLES non-nil means don't put angle brackets
2187 around function keys and event symbols. */)
2189 Lisp_Object key
, no_angles
;
2191 if (CONSP (key
) && lucid_event_type_list_p (key
))
2192 key
= Fevent_convert_list (key
);
2194 key
= EVENT_HEAD (key
);
2196 if (INTEGERP (key
)) /* Normal character */
2198 unsigned int charset
, c1
, c2
;
2199 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
2201 if (SINGLE_BYTE_CHAR_P (without_bits
))
2204 SPLIT_CHAR (without_bits
, charset
, c1
, c2
);
2207 && CHARSET_DEFINED_P (charset
)
2208 && ((c1
>= 0 && c1
< 32)
2209 || (c2
>= 0 && c2
< 32)))
2211 /* Handle a generic character. */
2213 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
2214 CHECK_STRING (name
);
2215 return concat2 (build_string ("Character set "), name
);
2219 char tem
[KEY_DESCRIPTION_SIZE
], *end
;
2223 end
= push_key_description (XUINT (key
), tem
, 1);
2225 nchars
= multibyte_chars_in_text (tem
, nbytes
);
2226 if (nchars
== nbytes
)
2229 string
= build_string (tem
);
2232 string
= make_multibyte_string (tem
, nchars
, nbytes
);
2236 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2238 if (NILP (no_angles
))
2241 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2242 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2243 return build_string (buffer
);
2246 return Fsymbol_name (key
);
2248 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2249 return Fcopy_sequence (key
);
2251 error ("KEY must be an integer, cons, symbol, or string");
2256 push_text_char_description (c
, p
)
2257 register unsigned int c
;
2269 *p
++ = c
+ 64; /* 'A' - 1 */
2281 /* This function cannot GC. */
2283 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2284 doc
: /* Return a pretty description of file-character CHARACTER.
2285 Control characters turn into "^char", etc. */)
2287 Lisp_Object character
;
2289 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2290 unsigned char str
[6];
2293 CHECK_NUMBER (character
);
2295 c
= XINT (character
);
2296 if (!SINGLE_BYTE_CHAR_P (c
))
2298 int len
= CHAR_STRING (c
, str
);
2300 return make_multibyte_string (str
, 1, len
);
2303 *push_text_char_description (c
& 0377, str
) = 0;
2305 return build_string (str
);
2308 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2311 ascii_sequence_p (seq
)
2315 int len
= XINT (Flength (seq
));
2317 for (i
= 0; i
< len
; i
++)
2319 Lisp_Object ii
, elt
;
2321 XSETFASTINT (ii
, i
);
2322 elt
= Faref (seq
, ii
);
2325 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2333 /* where-is - finding a command in a set of keymaps. */
2335 static Lisp_Object
where_is_internal ();
2336 static Lisp_Object
where_is_internal_1 ();
2337 static void where_is_internal_2 ();
2339 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2340 Returns the first non-nil binding found in any of those maps. */
2343 shadow_lookup (shadow
, key
, flag
)
2344 Lisp_Object shadow
, key
, flag
;
2346 Lisp_Object tail
, value
;
2348 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2350 value
= Flookup_key (XCAR (tail
), key
, flag
);
2351 if (!NILP (value
) && !NATNUMP (value
))
2357 static Lisp_Object Vmouse_events
;
2359 /* This function can GC if Flookup_key autoloads any keymaps. */
2362 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2363 Lisp_Object definition
, keymaps
;
2364 Lisp_Object firstonly
, noindirect
, no_remap
;
2366 Lisp_Object maps
= Qnil
;
2367 Lisp_Object found
, sequences
;
2368 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2369 /* 1 means ignore all menu bindings entirely. */
2370 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2372 /* If this command is remapped, then it has no key bindings
2374 if (NILP (no_remap
) && SYMBOLP (definition
))
2377 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2382 while (CONSP (found
))
2386 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2387 found
= XCDR (found
);
2390 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2394 for (; !NILP (maps
); maps
= Fcdr (maps
))
2396 /* Key sequence to reach map, and the map that it reaches */
2397 register Lisp_Object
this, map
, tem
;
2399 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2400 [M-CHAR] sequences, check if last character of the sequence
2401 is the meta-prefix char. */
2405 this = Fcar (Fcar (maps
));
2406 map
= Fcdr (Fcar (maps
));
2407 last
= make_number (XINT (Flength (this)) - 1);
2408 last_is_meta
= (XINT (last
) >= 0
2409 && EQ (Faref (this, last
), meta_prefix_char
));
2411 /* if (nomenus && !ascii_sequence_p (this)) */
2412 if (nomenus
&& XINT (last
) >= 0
2413 && SYMBOLP (tem
= Faref (this, make_number (0)))
2414 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2415 /* If no menu entries should be returned, skip over the
2416 keymaps bound to `menu-bar' and `tool-bar' and other
2417 non-ascii prefixes like `C-down-mouse-2'. */
2424 /* Because the code we want to run on each binding is rather
2425 large, we don't want to have two separate loop bodies for
2426 sparse keymap bindings and tables; we want to iterate one
2427 loop body over both keymap and vector bindings.
2429 For this reason, if Fcar (map) is a vector, we don't
2430 advance map to the next element until i indicates that we
2431 have finished off the vector. */
2432 Lisp_Object elt
, key
, binding
;
2440 /* Set key and binding to the current key and binding, and
2441 advance map and i to the next binding. */
2444 Lisp_Object sequence
;
2446 /* In a vector, look at each element. */
2447 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2449 binding
= AREF (elt
, i
);
2450 XSETFASTINT (key
, i
);
2451 sequence
= where_is_internal_1 (binding
, key
, definition
,
2453 last
, nomenus
, last_is_meta
);
2454 if (!NILP (sequence
))
2455 sequences
= Fcons (sequence
, sequences
);
2458 else if (CHAR_TABLE_P (elt
))
2460 Lisp_Object indices
[3];
2463 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2464 Qnil
), /* Result accumulator. */
2465 Fcons (Fcons (this, last
),
2466 Fcons (make_number (nomenus
),
2467 make_number (last_is_meta
))));
2468 map_char_table (where_is_internal_2
, Qnil
, elt
, elt
, args
,
2470 sequences
= XCDR (XCAR (args
));
2472 else if (CONSP (elt
))
2474 Lisp_Object sequence
;
2477 binding
= XCDR (elt
);
2479 sequence
= where_is_internal_1 (binding
, key
, definition
,
2481 last
, nomenus
, last_is_meta
);
2482 if (!NILP (sequence
))
2483 sequences
= Fcons (sequence
, sequences
);
2487 while (!NILP (sequences
))
2489 Lisp_Object sequence
, remapped
, function
;
2491 sequence
= XCAR (sequences
);
2492 sequences
= XCDR (sequences
);
2494 /* If the current sequence is a command remapping with
2495 format [remap COMMAND], find the key sequences
2496 which run COMMAND, and use those sequences instead. */
2499 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2500 && EQ (AREF (sequence
, 0), Qremap
)
2501 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2503 Lisp_Object remapped1
;
2505 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2506 if (CONSP (remapped1
))
2508 /* Verify that this key binding actually maps to the
2509 remapped command (see below). */
2510 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2512 sequence
= XCAR (remapped1
);
2513 remapped
= XCDR (remapped1
);
2514 goto record_sequence
;
2518 /* Verify that this key binding is not shadowed by another
2519 binding for the same key, before we say it exists.
2521 Mechanism: look for local definition of this key and if
2522 it is defined and does not match what we found then
2525 Either nil or number as value from Flookup_key
2527 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2531 /* It is a true unshadowed match. Record it, unless it's already
2532 been seen (as could happen when inheriting keymaps). */
2533 if (NILP (Fmember (sequence
, found
)))
2534 found
= Fcons (sequence
, found
);
2536 /* If firstonly is Qnon_ascii, then we can return the first
2537 binding we find. If firstonly is not Qnon_ascii but not
2538 nil, then we should return the first ascii-only binding
2540 if (EQ (firstonly
, Qnon_ascii
))
2541 RETURN_UNGCPRO (sequence
);
2542 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2543 RETURN_UNGCPRO (sequence
);
2545 if (CONSP (remapped
))
2547 sequence
= XCAR (remapped
);
2548 remapped
= XCDR (remapped
);
2549 goto record_sequence
;
2557 found
= Fnreverse (found
);
2559 /* firstonly may have been t, but we may have gone all the way through
2560 the keymaps without finding an all-ASCII key sequence. So just
2561 return the best we could find. */
2562 if (!NILP (firstonly
))
2563 return Fcar (found
);
2568 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2569 doc
: /* Return list of keys that invoke DEFINITION.
2570 If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2571 If KEYMAP is nil, search all the currently active keymaps.
2572 If KEYMAP is a list of keymaps, search only those keymaps.
2574 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2575 rather than a list of all possible key sequences.
2576 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2577 no matter what it is.
2578 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
2579 and entirely reject menu bindings.
2581 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2582 to other keymaps or slots. This makes it possible to search for an
2583 indirect definition itself.
2585 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2586 that invoke a command which is remapped to DEFINITION, but include the
2587 remapped command in the returned list. */)
2588 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2589 Lisp_Object definition
, keymap
;
2590 Lisp_Object firstonly
, noindirect
, no_remap
;
2592 Lisp_Object sequences
, keymaps
;
2593 /* 1 means ignore all menu bindings entirely. */
2594 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2597 /* Find the relevant keymaps. */
2598 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2600 else if (!NILP (keymap
))
2601 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2603 keymaps
= Fcurrent_active_maps (Qnil
);
2605 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2606 We don't really need to check `keymap'. */
2607 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2611 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2613 /* Check heuristic-consistency of the cache. */
2614 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2615 where_is_cache
= Qnil
;
2617 if (NILP (where_is_cache
))
2619 /* We need to create the cache. */
2620 Lisp_Object args
[2];
2621 where_is_cache
= Fmake_hash_table (0, args
);
2622 where_is_cache_keymaps
= Qt
;
2624 /* Fill in the cache. */
2625 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2626 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2629 where_is_cache_keymaps
= keymaps
;
2632 /* We want to process definitions from the last to the first.
2633 Instead of consing, copy definitions to a vector and step
2634 over that vector. */
2635 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2636 n
= XINT (Flength (sequences
));
2637 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2638 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2639 defns
[i
++] = XCAR (sequences
);
2641 /* Verify that the key bindings are not shadowed. Note that
2642 the following can GC. */
2643 GCPRO2 (definition
, keymaps
);
2646 for (i
= n
- 1; i
>= 0; --i
)
2647 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2649 if (ascii_sequence_p (defns
[i
]))
2655 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2660 /* Kill the cache so that where_is_internal_1 doesn't think
2661 we're filling it up. */
2662 where_is_cache
= Qnil
;
2663 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2669 /* This is the function that Fwhere_is_internal calls using map_char_table.
2671 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2673 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2674 Since map_char_table doesn't really use the return value from this function,
2675 we the result append to RESULT, the slot in ARGS.
2677 This function can GC because it calls where_is_internal_1 which can
2681 where_is_internal_2 (args
, key
, binding
)
2682 Lisp_Object args
, key
, binding
;
2684 Lisp_Object definition
, noindirect
, this, last
;
2685 Lisp_Object result
, sequence
;
2686 int nomenus
, last_is_meta
;
2687 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2689 GCPRO3 (args
, key
, binding
);
2690 result
= XCDR (XCAR (args
));
2691 definition
= XCAR (XCAR (XCAR (args
)));
2692 noindirect
= XCDR (XCAR (XCAR (args
)));
2693 this = XCAR (XCAR (XCDR (args
)));
2694 last
= XCDR (XCAR (XCDR (args
)));
2695 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2696 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2698 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2699 this, last
, nomenus
, last_is_meta
);
2701 if (!NILP (sequence
))
2702 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2708 /* This function cannot GC. */
2711 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2712 nomenus
, last_is_meta
)
2713 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2714 int nomenus
, last_is_meta
;
2716 Lisp_Object sequence
;
2718 /* Search through indirections unless that's not wanted. */
2719 if (NILP (noindirect
))
2720 binding
= get_keyelt (binding
, 0);
2722 /* End this iteration if this element does not match
2725 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2726 || EQ (binding
, definition
)
2727 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2728 /* Doesn't match. */
2731 /* We have found a match. Construct the key sequence where we found it. */
2732 if (INTEGERP (key
) && last_is_meta
)
2734 sequence
= Fcopy_sequence (this);
2735 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2738 sequence
= append_key (this, key
);
2740 if (!NILP (where_is_cache
))
2742 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2743 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2750 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2752 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2753 doc
: /* Insert the list of all defined keys and their definitions.
2754 The list is inserted in the current buffer, while the bindings are
2755 looked up in BUFFER.
2756 The optional argument PREFIX, if non-nil, should be a key sequence;
2757 then we display only bindings that start with that prefix.
2758 The optional argument MENUS, if non-nil, says to mention menu bindings.
2759 \(Ordinarily these are omitted from the output.) */)
2760 (buffer
, prefix
, menus
)
2761 Lisp_Object buffer
, prefix
, menus
;
2763 Lisp_Object outbuf
, shadow
;
2764 int nomenu
= NILP (menus
);
2765 register Lisp_Object start1
;
2766 struct gcpro gcpro1
;
2768 char *alternate_heading
2770 Keyboard translations:\n\n\
2771 You type Translation\n\
2772 -------- -----------\n";
2777 outbuf
= Fcurrent_buffer ();
2779 /* Report on alternates for keys. */
2780 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2783 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2784 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2786 for (c
= 0; c
< translate_len
; c
++)
2787 if (translate
[c
] != c
)
2789 char buf
[KEY_DESCRIPTION_SIZE
];
2792 if (alternate_heading
)
2794 insert_string (alternate_heading
);
2795 alternate_heading
= 0;
2798 bufend
= push_key_description (translate
[c
], buf
, 1);
2799 insert (buf
, bufend
- buf
);
2800 Findent_to (make_number (16), make_number (1));
2801 bufend
= push_key_description (c
, buf
, 1);
2802 insert (buf
, bufend
- buf
);
2810 if (!NILP (Vkey_translation_map
))
2811 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2812 "Key translations", nomenu
, 1, 0);
2815 /* Print the (major mode) local map. */
2817 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2818 start1
= current_kboard
->Voverriding_terminal_local_map
;
2819 else if (!NILP (Voverriding_local_map
))
2820 start1
= Voverriding_local_map
;
2824 describe_map_tree (start1
, 1, shadow
, prefix
,
2825 "\f\nOverriding Bindings", nomenu
, 0, 0);
2826 shadow
= Fcons (start1
, shadow
);
2830 /* Print the minor mode and major mode keymaps. */
2832 Lisp_Object
*modes
, *maps
;
2834 /* Temporarily switch to `buffer', so that we can get that buffer's
2835 minor modes correctly. */
2836 Fset_buffer (buffer
);
2838 nmaps
= current_minor_maps (&modes
, &maps
);
2839 Fset_buffer (outbuf
);
2841 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2842 XBUFFER (buffer
), Qkeymap
);
2845 describe_map_tree (start1
, 1, shadow
, prefix
,
2846 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2847 shadow
= Fcons (start1
, shadow
);
2850 /* Print the minor mode maps. */
2851 for (i
= 0; i
< nmaps
; i
++)
2853 /* The title for a minor mode keymap
2854 is constructed at run time.
2855 We let describe_map_tree do the actual insertion
2856 because it takes care of other features when doing so. */
2859 if (!SYMBOLP (modes
[i
]))
2862 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2866 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2867 SCHARS (SYMBOL_NAME (modes
[i
])));
2868 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2870 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2871 p
+= sizeof (" Minor Mode Bindings") - 1;
2874 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2875 shadow
= Fcons (maps
[i
], shadow
);
2878 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2879 XBUFFER (buffer
), Qlocal_map
);
2882 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2883 describe_map_tree (start1
, 1, shadow
, prefix
,
2884 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2886 describe_map_tree (start1
, 1, shadow
, prefix
,
2887 "\f\n`local-map' Property Bindings",
2890 shadow
= Fcons (start1
, shadow
);
2894 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2895 "\f\nGlobal Bindings", nomenu
, 0, 1);
2897 /* Print the function-key-map translations under this prefix. */
2898 if (!NILP (Vfunction_key_map
))
2899 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2900 "\f\nFunction key map translations", nomenu
, 1, 0);
2906 /* Insert a description of the key bindings in STARTMAP,
2907 followed by those of all maps reachable through STARTMAP.
2908 If PARTIAL is nonzero, omit certain "uninteresting" commands
2909 (such as `undefined').
2910 If SHADOW is non-nil, it is a list of maps;
2911 don't mention keys which would be shadowed by any of them.
2912 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2913 TITLE, if not 0, is a string to insert at the beginning.
2914 TITLE should not end with a colon or a newline; we supply that.
2915 If NOMENU is not 0, then omit menu-bar commands.
2917 If TRANSL is nonzero, the definitions are actually key translations
2918 so print strings and vectors differently.
2920 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2924 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2926 Lisp_Object startmap
, shadow
, prefix
;
2933 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2934 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2941 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2944 GCPRO3 (maps
, seen
, sub_shadows
);
2950 /* Delete from MAPS each element that is for the menu bar. */
2951 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2953 Lisp_Object elt
, prefix
, tem
;
2956 prefix
= Fcar (elt
);
2957 if (XVECTOR (prefix
)->size
>= 1)
2959 tem
= Faref (prefix
, make_number (0));
2960 if (EQ (tem
, Qmenu_bar
))
2961 maps
= Fdelq (elt
, maps
);
2966 if (!NILP (maps
) || always_title
)
2970 insert_string (title
);
2973 insert_string (" Starting With ");
2974 insert1 (Fkey_description (prefix
, Qnil
));
2976 insert_string (":\n");
2978 insert_string (key_heading
);
2982 for (; !NILP (maps
); maps
= Fcdr (maps
))
2984 register Lisp_Object elt
, prefix
, tail
;
2987 prefix
= Fcar (elt
);
2991 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2995 shmap
= XCAR (tail
);
2997 /* If the sequence by which we reach this keymap is zero-length,
2998 then the shadow map for this keymap is just SHADOW. */
2999 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
3000 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3002 /* If the sequence by which we reach this keymap actually has
3003 some elements, then the sequence's definition in SHADOW is
3004 what we should use. */
3007 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3008 if (INTEGERP (shmap
))
3012 /* If shmap is not nil and not a keymap,
3013 it completely shadows this map, so don't
3014 describe this map at all. */
3015 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3019 sub_shadows
= Fcons (shmap
, sub_shadows
);
3022 /* Maps we have already listed in this loop shadow this map. */
3023 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3026 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3028 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3031 describe_map (Fcdr (elt
), prefix
,
3032 transl
? describe_translation
: describe_command
,
3033 partial
, sub_shadows
, &seen
, nomenu
);
3039 insert_string ("\n");
3044 static int previous_description_column
;
3047 describe_command (definition
, args
)
3048 Lisp_Object definition
, args
;
3050 register Lisp_Object tem1
;
3051 int column
= (int) current_column (); /* iftc */
3052 int description_column
;
3054 /* If column 16 is no good, go to col 32;
3055 but don't push beyond that--go to next line instead. */
3059 description_column
= 32;
3061 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3062 description_column
= 32;
3064 description_column
= 16;
3066 Findent_to (make_number (description_column
), make_number (1));
3067 previous_description_column
= description_column
;
3069 if (SYMBOLP (definition
))
3071 tem1
= SYMBOL_NAME (definition
);
3073 insert_string ("\n");
3075 else if (STRINGP (definition
) || VECTORP (definition
))
3076 insert_string ("Keyboard Macro\n");
3077 else if (KEYMAPP (definition
))
3078 insert_string ("Prefix Command\n");
3080 insert_string ("??\n");
3084 describe_translation (definition
, args
)
3085 Lisp_Object definition
, args
;
3087 register Lisp_Object tem1
;
3089 Findent_to (make_number (16), make_number (1));
3091 if (SYMBOLP (definition
))
3093 tem1
= SYMBOL_NAME (definition
);
3095 insert_string ("\n");
3097 else if (STRINGP (definition
) || VECTORP (definition
))
3099 insert1 (Fkey_description (definition
, Qnil
));
3100 insert_string ("\n");
3102 else if (KEYMAPP (definition
))
3103 insert_string ("Prefix Command\n");
3105 insert_string ("??\n");
3108 /* Describe the contents of map MAP, assuming that this map itself is
3109 reached by the sequence of prefix keys PREFIX (a string or vector).
3110 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3113 describe_map (map
, prefix
, elt_describer
, partial
, shadow
, seen
, nomenu
)
3114 register Lisp_Object map
;
3116 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3122 Lisp_Object tail
, definition
, event
;
3124 Lisp_Object suppress
;
3127 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3132 suppress
= intern ("suppress-keymap");
3134 /* This vector gets used to present single keys to Flookup_key. Since
3135 that is done once per keymap element, we don't want to cons up a
3136 fresh vector every time. */
3137 kludge
= Fmake_vector (make_number (1), Qnil
);
3140 GCPRO3 (prefix
, definition
, kludge
);
3142 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3146 if (VECTORP (XCAR (tail
))
3147 || CHAR_TABLE_P (XCAR (tail
)))
3148 describe_vector (XCAR (tail
),
3149 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3151 else if (CONSP (XCAR (tail
)))
3153 event
= XCAR (XCAR (tail
));
3155 /* Ignore bindings whose "prefix" are not really valid events.
3156 (We get these in the frames and buffers menu.) */
3157 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3160 if (nomenu
&& EQ (event
, Qmenu_bar
))
3163 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3165 /* Don't show undefined commands or suppressed commands. */
3166 if (NILP (definition
)) continue;
3167 if (SYMBOLP (definition
) && partial
)
3169 tem
= Fget (definition
, suppress
);
3174 /* Don't show a command that isn't really visible
3175 because a local definition of the same key shadows it. */
3177 ASET (kludge
, 0, event
);
3180 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3181 if (!NILP (tem
)) continue;
3184 tem
= Flookup_key (map
, kludge
, Qt
);
3185 if (!EQ (tem
, definition
)) continue;
3189 previous_description_column
= 0;
3194 /* THIS gets the string to describe the character EVENT. */
3195 insert1 (Fkey_description (kludge
, prefix
));
3197 /* Print a description of the definition of this character.
3198 elt_describer will take care of spacing out far enough
3199 for alignment purposes. */
3200 (*elt_describer
) (definition
, Qnil
);
3202 else if (EQ (XCAR (tail
), Qkeymap
))
3204 /* The same keymap might be in the structure twice, if we're
3205 using an inherited keymap. So skip anything we've already
3207 tem
= Fassq (tail
, *seen
);
3208 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3210 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3218 describe_vector_princ (elt
, fun
)
3219 Lisp_Object elt
, fun
;
3221 Findent_to (make_number (16), make_number (1));
3226 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3227 doc
: /* Insert a description of contents of VECTOR.
3228 This is text showing the elements of vector matched against indices. */)
3230 Lisp_Object vector
, describer
;
3232 int count
= SPECPDL_INDEX ();
3233 if (NILP (describer
))
3234 describer
= intern ("princ");
3235 specbind (Qstandard_output
, Fcurrent_buffer ());
3236 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3237 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3238 Qnil
, Qnil
, (int *)0, 0, 0);
3240 return unbind_to (count
, Qnil
);
3243 /* Insert in the current buffer a description of the contents of VECTOR.
3244 We call ELT_DESCRIBER to insert the description of one value found
3247 ELT_PREFIX describes what "comes before" the keys or indices defined
3248 by this vector. This is a human-readable string whose size
3249 is not necessarily related to the situation.
3251 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3252 leads to this keymap.
3254 If the vector is a chartable, ELT_PREFIX is the vector
3255 of bytes that lead to the character set or portion of a character
3256 set described by this chartable.
3258 If PARTIAL is nonzero, it means do not mention suppressed commands
3259 (that assumes the vector is in a keymap).
3261 SHADOW is a list of keymaps that shadow this map.
3262 If it is non-nil, then we look up the key in those maps
3263 and we don't mention it now if it is defined by any of them.
3265 ENTIRE_MAP is the keymap in which this vector appears.
3266 If the definition in effect in the whole map does not match
3267 the one in this vector, we ignore this one.
3269 When describing a sub-char-table, INDICES is a list of
3270 indices at higher levels in this char-table,
3271 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3273 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3275 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3278 describe_vector (vector
, prefix
, args
, elt_describer
,
3279 partial
, shadow
, entire_map
,
3280 indices
, char_table_depth
, keymap_p
)
3281 register Lisp_Object vector
;
3282 Lisp_Object prefix
, args
;
3283 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3286 Lisp_Object entire_map
;
3288 int char_table_depth
;
3291 Lisp_Object definition
;
3293 Lisp_Object elt_prefix
= Qnil
;
3295 Lisp_Object suppress
;
3298 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3299 /* Range of elements to be handled. */
3301 /* A flag to tell if a leaf in this level of char-table is not a
3302 generic character (i.e. a complete multibyte character). */
3310 indices
= (int *) alloca (3 * sizeof (int));
3316 /* Call Fkey_description first, to avoid GC bug for the other string. */
3317 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3320 tem
= Fkey_description (prefix
, Qnil
);
3321 elt_prefix
= concat2 (tem
, build_string (" "));
3326 /* This vector gets used to present single keys to Flookup_key. Since
3327 that is done once per vector element, we don't want to cons up a
3328 fresh vector every time. */
3329 kludge
= Fmake_vector (make_number (1), Qnil
);
3330 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3333 suppress
= intern ("suppress-keymap");
3335 if (CHAR_TABLE_P (vector
))
3337 if (char_table_depth
== 0)
3339 /* VECTOR is a top level char-table. */
3342 to
= CHAR_TABLE_ORDINARY_SLOTS
;
3346 /* VECTOR is a sub char-table. */
3347 if (char_table_depth
>= 3)
3348 /* A char-table is never that deep. */
3349 error ("Too deep char table");
3352 = (CHARSET_VALID_P (indices
[0])
3353 && ((CHARSET_DIMENSION (indices
[0]) == 1
3354 && char_table_depth
== 1)
3355 || char_table_depth
== 2));
3357 /* Meaningful elements are from 32th to 127th. */
3359 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
3364 /* This does the right thing for ordinary vectors. */
3368 to
= XVECTOR (vector
)->size
;
3371 for (i
= from
; i
< to
; i
++)
3375 if (CHAR_TABLE_P (vector
))
3377 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3380 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3381 && !CHARSET_DEFINED_P (i
- 128))
3385 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3388 definition
= get_keyelt (AREF (vector
, i
), 0);
3390 if (NILP (definition
)) continue;
3392 /* Don't mention suppressed commands. */
3393 if (SYMBOLP (definition
) && partial
)
3397 tem
= Fget (definition
, suppress
);
3399 if (!NILP (tem
)) continue;
3402 /* Set CHARACTER to the character this entry describes, if any.
3403 Also update *INDICES. */
3404 if (CHAR_TABLE_P (vector
))
3406 indices
[char_table_depth
] = i
;
3408 if (char_table_depth
== 0)
3411 indices
[0] = i
- 128;
3413 else if (complete_char
)
3415 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3423 ASET (kludge
, 0, make_number (character
));
3425 /* If this binding is shadowed by some other map, ignore it. */
3426 if (!NILP (shadow
) && complete_char
)
3430 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3432 if (!NILP (tem
)) continue;
3435 /* Ignore this definition if it is shadowed by an earlier
3436 one in the same keymap. */
3437 if (!NILP (entire_map
) && complete_char
)
3441 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3443 if (!EQ (tem
, definition
))
3449 if (char_table_depth
== 0)
3454 /* For a sub char-table, show the depth by indentation.
3455 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3456 if (char_table_depth
> 0)
3457 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3459 /* Output the prefix that applies to every entry in this map. */
3460 if (!NILP (elt_prefix
))
3461 insert1 (elt_prefix
);
3463 /* Insert or describe the character this slot is for,
3464 or a description of what it is for. */
3465 if (SUB_CHAR_TABLE_P (vector
))
3468 insert_char (character
);
3471 /* We need an octal representation for this block of
3474 sprintf (work
, "(row %d)", i
);
3475 insert (work
, strlen (work
));
3478 else if (CHAR_TABLE_P (vector
))
3481 insert1 (Fkey_description (kludge
, prefix
));
3484 /* Print the information for this character set. */
3485 insert_string ("<");
3486 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3488 insert_from_string (tem2
, 0, 0, SCHARS (tem2
),
3497 insert1 (Fkey_description (kludge
, prefix
));
3500 /* If we find a sub char-table within a char-table,
3501 scan it recursively; it defines the details for
3502 a character set or a portion of a character set. */
3503 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3506 describe_vector (definition
, prefix
, args
, elt_describer
,
3507 partial
, shadow
, entire_map
,
3508 indices
, char_table_depth
+ 1, keymap_p
);
3514 /* Find all consecutive characters or rows that have the same
3515 definition. But, for elements of a top level char table, if
3516 they are for charsets, we had better describe one by one even
3517 if they have the same definition. */
3518 if (CHAR_TABLE_P (vector
))
3522 if (char_table_depth
== 0)
3523 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3525 while (i
+ 1 < limit
3526 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3528 && !NILP (Fequal (tem2
, definition
)))
3533 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3535 && !NILP (Fequal (tem2
, definition
)))
3539 /* If we have a range of more than one character,
3540 print where the range reaches to. */
3542 if (i
!= starting_i
)
3546 ASET (kludge
, 0, make_number (i
));
3548 if (!NILP (elt_prefix
))
3549 insert1 (elt_prefix
);
3551 if (CHAR_TABLE_P (vector
))
3553 if (char_table_depth
== 0)
3555 insert1 (Fkey_description (kludge
, prefix
));
3557 else if (complete_char
)
3559 indices
[char_table_depth
] = i
;
3560 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3561 insert_char (character
);
3565 /* We need an octal representation for this block of
3568 sprintf (work
, "(row %d)", i
);
3569 insert (work
, strlen (work
));
3574 insert1 (Fkey_description (kludge
, prefix
));
3578 /* Print a description of the definition of this character.
3579 elt_describer will take care of spacing out far enough
3580 for alignment purposes. */
3581 (*elt_describer
) (definition
, args
);
3584 /* For (sub) char-table, print `defalt' slot at last. */
3585 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3587 insert (" ", char_table_depth
* 2);
3588 insert_string ("<<default>>");
3589 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3595 /* Apropos - finding all symbols whose names match a regexp. */
3596 static Lisp_Object apropos_predicate
;
3597 static Lisp_Object apropos_accumulate
;
3600 apropos_accum (symbol
, string
)
3601 Lisp_Object symbol
, string
;
3603 register Lisp_Object tem
;
3605 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3606 if (!NILP (tem
) && !NILP (apropos_predicate
))
3607 tem
= call1 (apropos_predicate
, symbol
);
3609 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3612 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3613 doc
: /* Show all symbols whose names contain match for REGEXP.
3614 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3615 for each symbol and a symbol is mentioned only if that returns non-nil.
3616 Return list of symbols found. */)
3618 Lisp_Object regexp
, predicate
;
3621 CHECK_STRING (regexp
);
3622 apropos_predicate
= predicate
;
3623 apropos_accumulate
= Qnil
;
3624 map_obarray (Vobarray
, apropos_accum
, regexp
);
3625 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3626 apropos_accumulate
= Qnil
;
3627 apropos_predicate
= Qnil
;
3634 Qkeymap
= intern ("keymap");
3635 staticpro (&Qkeymap
);
3636 staticpro (&apropos_predicate
);
3637 staticpro (&apropos_accumulate
);
3638 apropos_predicate
= Qnil
;
3639 apropos_accumulate
= Qnil
;
3641 /* Now we are ready to set up this property, so we can
3642 create char tables. */
3643 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3645 /* Initialize the keymaps standardly used.
3646 Each one is the value of a Lisp variable, and is also
3647 pointed to by a C variable */
3649 global_map
= Fmake_keymap (Qnil
);
3650 Fset (intern ("global-map"), global_map
);
3652 current_global_map
= global_map
;
3653 staticpro (&global_map
);
3654 staticpro (¤t_global_map
);
3656 meta_map
= Fmake_keymap (Qnil
);
3657 Fset (intern ("esc-map"), meta_map
);
3658 Ffset (intern ("ESC-prefix"), meta_map
);
3660 control_x_map
= Fmake_keymap (Qnil
);
3661 Fset (intern ("ctl-x-map"), control_x_map
);
3662 Ffset (intern ("Control-X-prefix"), control_x_map
);
3665 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3666 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3667 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3668 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3669 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3671 staticpro (&exclude_keys
);
3673 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3674 doc
: /* List of commands given new key bindings recently.
3675 This is used for internal purposes during Emacs startup;
3676 don't alter it yourself. */);
3677 Vdefine_key_rebound_commands
= Qt
;
3679 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3680 doc
: /* Default keymap to use when reading from the minibuffer. */);
3681 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3683 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3684 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3685 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3686 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3688 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3689 doc
: /* Local keymap for minibuffer input with completion. */);
3690 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3691 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3693 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3694 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3695 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3696 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3697 Vminibuffer_local_completion_map
);
3699 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3700 doc
: /* Alist of keymaps to use for minor modes.
3701 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3702 key sequences and look up bindings iff VARIABLE's value is non-nil.
3703 If two active keymaps bind the same key, the keymap appearing earlier
3704 in the list takes precedence. */);
3705 Vminor_mode_map_alist
= Qnil
;
3707 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3708 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3709 This variable is an alist just like `minor-mode-map-alist', and it is
3710 used the same way (and before `minor-mode-map-alist'); however,
3711 it is provided for major modes to bind locally. */);
3712 Vminor_mode_overriding_map_alist
= Qnil
;
3714 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3715 doc
: /* List of keymap alists to use for emulations modes.
3716 It is intended for modes or packages using multiple minor-mode keymaps.
3717 Each element is a keymap alist just like `minor-mode-map-alist', or a
3718 symbol with a variable binding which is a keymap alist, and it is used
3719 the same way. The "active" keymaps in each alist are used before
3720 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3721 Vemulation_mode_map_alists
= Qnil
;
3724 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3725 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3726 This allows Emacs to recognize function keys sent from ASCII
3727 terminals at any point in a key sequence.
3729 The `read-key-sequence' function replaces any subsequence bound by
3730 `function-key-map' with its binding. More precisely, when the active
3731 keymaps have no binding for the current key sequence but
3732 `function-key-map' binds a suffix of the sequence to a vector or string,
3733 `read-key-sequence' replaces the matching suffix with its binding, and
3734 continues with the new sequence.
3736 The events that come from bindings in `function-key-map' are not
3737 themselves looked up in `function-key-map'.
3739 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3740 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3741 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3742 key, typing `ESC O P x' would return [f1 x]. */);
3743 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3745 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3746 doc
: /* Keymap of key translations that can override keymaps.
3747 This keymap works like `function-key-map', but comes after that,
3748 and applies even for keys that have ordinary bindings. */);
3749 Vkey_translation_map
= Qnil
;
3751 staticpro (&Vmouse_events
);
3752 Vmouse_events
= Fcons (intern ("menu-bar"),
3753 Fcons (intern ("tool-bar"),
3754 Fcons (intern ("header-line"),
3755 Fcons (intern ("mode-line"),
3756 Fcons (intern ("mouse-1"),
3757 Fcons (intern ("mouse-2"),
3758 Fcons (intern ("mouse-3"),
3759 Fcons (intern ("mouse-4"),
3760 Fcons (intern ("mouse-5"),
3764 Qsingle_key_description
= intern ("single-key-description");
3765 staticpro (&Qsingle_key_description
);
3767 Qkey_description
= intern ("key-description");
3768 staticpro (&Qkey_description
);
3770 Qkeymapp
= intern ("keymapp");
3771 staticpro (&Qkeymapp
);
3773 Qnon_ascii
= intern ("non-ascii");
3774 staticpro (&Qnon_ascii
);
3776 Qmenu_item
= intern ("menu-item");
3777 staticpro (&Qmenu_item
);
3779 Qremap
= intern ("remap");
3780 staticpro (&Qremap
);
3782 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3783 staticpro (&command_remapping_vector
);
3785 where_is_cache_keymaps
= Qt
;
3786 where_is_cache
= Qnil
;
3787 staticpro (&where_is_cache
);
3788 staticpro (&where_is_cache_keymaps
);
3790 defsubr (&Skeymapp
);
3791 defsubr (&Skeymap_parent
);
3792 defsubr (&Skeymap_prompt
);
3793 defsubr (&Sset_keymap_parent
);
3794 defsubr (&Smake_keymap
);
3795 defsubr (&Smake_sparse_keymap
);
3796 defsubr (&Smap_keymap
);
3797 defsubr (&Scopy_keymap
);
3798 defsubr (&Scommand_remapping
);
3799 defsubr (&Skey_binding
);
3800 defsubr (&Slocal_key_binding
);
3801 defsubr (&Sglobal_key_binding
);
3802 defsubr (&Sminor_mode_key_binding
);
3803 defsubr (&Sdefine_key
);
3804 defsubr (&Slookup_key
);
3805 defsubr (&Sdefine_prefix_command
);
3806 defsubr (&Suse_global_map
);
3807 defsubr (&Suse_local_map
);
3808 defsubr (&Scurrent_local_map
);
3809 defsubr (&Scurrent_global_map
);
3810 defsubr (&Scurrent_minor_mode_maps
);
3811 defsubr (&Scurrent_active_maps
);
3812 defsubr (&Saccessible_keymaps
);
3813 defsubr (&Skey_description
);
3814 defsubr (&Sdescribe_vector
);
3815 defsubr (&Ssingle_key_description
);
3816 defsubr (&Stext_char_description
);
3817 defsubr (&Swhere_is_internal
);
3818 defsubr (&Sdescribe_buffer_bindings
);
3819 defsubr (&Sapropos_internal
);
3825 initial_define_key (global_map
, 033, "ESC-prefix");
3826 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3829 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3830 (do not change this comment) */