1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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 silly_event_symbol_error
P_ ((Lisp_Object
));
126 /* Keymap object support - constructors and predicates. */
128 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
129 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
130 CHARTABLE is a char-table that holds the bindings for the ASCII
131 characters. ALIST is an assoc-list which holds bindings for function keys,
132 mouse events, and any other things that appear in the input stream.
133 All entries in it are initially nil, meaning "command undefined".
135 The optional arg STRING supplies a menu name for the keymap
136 in case you use it as a menu with `x-popup-menu'. */)
142 tail
= Fcons (string
, Qnil
);
145 return Fcons (Qkeymap
,
146 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
149 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
150 doc
: /* Construct and return a new sparse keymap.
151 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
152 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
153 which binds the function key or mouse event SYMBOL to DEFINITION.
154 Initially the alist is nil.
156 The optional arg STRING supplies a menu name for the keymap
157 in case you use it as a menu with `x-popup-menu'. */)
162 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
163 return Fcons (Qkeymap
, Qnil
);
166 /* This function is used for installing the standard key bindings
167 at initialization time.
171 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
174 initial_define_key (keymap
, key
, defname
)
179 store_in_keymap (keymap
, make_number (key
), intern (defname
));
183 initial_define_lispy_key (keymap
, keyname
, defname
)
188 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
191 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
192 doc
: /* Return t if OBJECT is a keymap.
194 A keymap is a list (keymap . ALIST),
195 or a symbol whose function definition is itself a keymap.
196 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
197 a vector of densely packed bindings for small character codes
198 is also allowed as an element. */)
202 return (KEYMAPP (object
) ? Qt
: Qnil
);
205 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
206 doc
: /* Return the prompt-string of a keymap MAP.
207 If non-nil, the prompt is shown in the echo-area
208 when reading a key-sequence to be looked-up in this keymap. */)
214 register Lisp_Object tem
;
223 /* Check that OBJECT is a keymap (after dereferencing through any
224 symbols). If it is, return it.
226 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
227 is an autoload form, do the autoload and try again.
228 If AUTOLOAD is nonzero, callers must assume GC is possible.
230 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
231 is zero as well), return Qt.
233 ERROR controls how we respond if OBJECT isn't a keymap.
234 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
236 Note that most of the time, we don't want to pursue autoloads.
237 Functions like Faccessible_keymaps which scan entire keymap trees
238 shouldn't load every autoloaded keymap. I'm not sure about this,
239 but it seems to me that only read_key_sequence, Flookup_key, and
240 Fdefine_key should cause keymaps to be autoloaded.
242 This function can GC when AUTOLOAD is non-zero, because it calls
243 do_autoload which can GC. */
246 get_keymap (object
, error
, autoload
)
255 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
258 tem
= indirect_function (object
);
261 if (EQ (XCAR (tem
), Qkeymap
))
264 /* Should we do an autoload? Autoload forms for keymaps have
265 Qkeymap as their fifth element. */
266 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
))
270 tail
= Fnth (make_number (4), tem
);
271 if (EQ (tail
, Qkeymap
))
275 struct gcpro gcpro1
, gcpro2
;
277 GCPRO2 (tem
, object
);
278 do_autoload (tem
, object
);
291 wrong_type_argument (Qkeymapp
, object
);
295 /* Return the parent map of KEYMAP, or nil if it has none.
296 We assume that KEYMAP is a valid keymap. */
299 keymap_parent (keymap
, autoload
)
305 keymap
= get_keymap (keymap
, 1, autoload
);
307 /* Skip past the initial element `keymap'. */
308 list
= XCDR (keymap
);
309 for (; CONSP (list
); list
= XCDR (list
))
311 /* See if there is another `keymap'. */
316 return get_keymap (list
, 0, autoload
);
319 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
320 doc
: /* Return the parent keymap of KEYMAP. */)
324 return keymap_parent (keymap
, 1);
327 /* Check whether MAP is one of MAPS parents. */
329 keymap_memberp (map
, maps
)
330 Lisp_Object map
, maps
;
332 if (NILP (map
)) return 0;
333 while (KEYMAPP (maps
) && !EQ (map
, maps
))
334 maps
= keymap_parent (maps
, 0);
335 return (EQ (map
, maps
));
338 /* Set the parent keymap of MAP to PARENT. */
340 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
341 doc
: /* Modify KEYMAP to set its parent map to PARENT.
342 PARENT should be nil or another keymap. */)
344 Lisp_Object keymap
, parent
;
346 Lisp_Object list
, prev
;
347 struct gcpro gcpro1
, gcpro2
;
350 /* Force a keymap flush for the next call to where-is.
351 Since this can be called from within where-is, we don't set where_is_cache
352 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
353 be changed during where-is, while where_is_cache_keymaps is only used at
354 the very beginning of where-is and can thus be changed here without any
356 This is a very minor correctness (rather than safety) issue. */
357 where_is_cache_keymaps
= Qt
;
359 GCPRO2 (keymap
, parent
);
360 keymap
= get_keymap (keymap
, 1, 1);
364 parent
= get_keymap (parent
, 1, 1);
366 /* Check for cycles. */
367 if (keymap_memberp (keymap
, parent
))
368 error ("Cyclic keymap inheritance");
371 /* Skip past the initial element `keymap'. */
376 /* If there is a parent keymap here, replace it.
377 If we came to the end, add the parent in PREV. */
378 if (!CONSP (list
) || KEYMAPP (list
))
380 /* If we already have the right parent, return now
381 so that we avoid the loops below. */
382 if (EQ (XCDR (prev
), parent
))
383 RETURN_UNGCPRO (parent
);
385 XSETCDR (prev
, parent
);
391 /* Scan through for submaps, and set their parents too. */
393 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
395 /* Stop the scan when we come to the parent. */
396 if (EQ (XCAR (list
), Qkeymap
))
399 /* If this element holds a prefix map, deal with it. */
400 if (CONSP (XCAR (list
))
401 && CONSP (XCDR (XCAR (list
))))
402 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
405 if (VECTORP (XCAR (list
)))
406 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
407 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
408 fix_submap_inheritance (keymap
, make_number (i
),
409 XVECTOR (XCAR (list
))->contents
[i
]);
411 if (CHAR_TABLE_P (XCAR (list
)))
413 Lisp_Object indices
[3];
415 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
),
420 RETURN_UNGCPRO (parent
);
423 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
424 if EVENT is also a prefix in MAP's parent,
425 make sure that SUBMAP inherits that definition as its own parent. */
428 fix_submap_inheritance (map
, event
, submap
)
429 Lisp_Object map
, event
, submap
;
431 Lisp_Object map_parent
, parent_entry
;
433 /* SUBMAP is a cons that we found as a key binding.
434 Discard the other things found in a menu key binding. */
436 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
438 /* If it isn't a keymap now, there's no work to do. */
442 map_parent
= keymap_parent (map
, 0);
443 if (!NILP (map_parent
))
445 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
449 /* If MAP's parent has something other than a keymap,
450 our own submap shadows it completely. */
451 if (!CONSP (parent_entry
))
454 if (! EQ (parent_entry
, submap
))
456 Lisp_Object submap_parent
;
457 submap_parent
= submap
;
462 tem
= keymap_parent (submap_parent
, 0);
466 if (keymap_memberp (tem
, parent_entry
))
467 /* Fset_keymap_parent could create a cycle. */
474 Fset_keymap_parent (submap_parent
, parent_entry
);
478 /* Look up IDX in MAP. IDX may be any sort of event.
479 Note that this does only one level of lookup; IDX must be a single
480 event, not a sequence.
482 If T_OK is non-zero, bindings for Qt are treated as default
483 bindings; any key left unmentioned by other tables and bindings is
484 given the binding of Qt.
486 If T_OK is zero, bindings for Qt are not treated specially.
488 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
491 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
500 /* Qunbound in VAL means we have found no binding yet. */
503 /* If idx is a list (some sort of mouse click, perhaps?),
504 the index we want to use is the car of the list, which
505 ought to be a symbol. */
506 idx
= EVENT_HEAD (idx
);
508 /* If idx is a symbol, it might have modifiers, which need to
509 be put in the canonical order. */
511 idx
= reorder_modifiers (idx
);
512 else if (INTEGERP (idx
))
513 /* Clobber the high bits that can be present on a machine
514 with more than 24 bits of integer. */
515 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
517 /* Handle the special meta -> esc mapping. */
518 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
520 /* See if there is a meta-map. If there's none, there is
521 no binding for IDX, unless a default binding exists in MAP. */
523 Lisp_Object meta_map
;
525 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
526 t_ok
, noinherit
, autoload
),
529 if (CONSP (meta_map
))
532 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
535 /* Set IDX to t, so that we only find a default binding. */
538 /* We know there is no binding. */
542 /* t_binding is where we put a default binding that applies,
543 to use in case we do not find a binding specifically
544 for this key sequence. */
547 Lisp_Object t_binding
= Qnil
;
548 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
550 GCPRO4 (map
, tail
, idx
, t_binding
);
552 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
553 If it is 1, only generic-char bindings are accepted.
554 Otherwise, neither are. */
557 for (tail
= XCDR (map
);
559 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
564 binding
= XCAR (tail
);
565 if (SYMBOLP (binding
))
567 /* If NOINHERIT, stop finding prefix definitions
568 after we pass a second occurrence of the `keymap' symbol. */
569 if (noinherit
&& EQ (binding
, Qkeymap
))
570 RETURN_UNGCPRO (Qnil
);
572 else if (CONSP (binding
))
574 Lisp_Object key
= XCAR (binding
);
577 val
= XCDR (binding
);
580 && (XINT (idx
) & CHAR_MODIFIER_MASK
) == 0
582 && (XINT (key
) & CHAR_MODIFIER_MASK
) == 0
583 && !SINGLE_BYTE_CHAR_P (XINT (idx
))
584 && !SINGLE_BYTE_CHAR_P (XINT (key
))
585 && CHAR_VALID_P (XINT (key
), 1)
586 && !CHAR_VALID_P (XINT (key
), 0)
587 && (CHAR_CHARSET (XINT (key
))
588 == CHAR_CHARSET (XINT (idx
))))
590 /* KEY is the generic character of the charset of IDX.
591 Use KEY's binding if there isn't a binding for IDX
593 t_binding
= XCDR (binding
);
596 else if (t_ok
> 1 && EQ (key
, Qt
))
598 t_binding
= XCDR (binding
);
602 else if (VECTORP (binding
))
604 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
605 val
= AREF (binding
, XFASTINT (idx
));
607 else if (CHAR_TABLE_P (binding
))
609 /* Character codes with modifiers
610 are not included in a char-table.
611 All character codes without modifiers are included. */
612 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
614 val
= Faref (binding
, idx
);
615 /* `nil' has a special meaning for char-tables, so
616 we use something else to record an explicitly
623 /* If we found a binding, clean it up and return it. */
624 if (!EQ (val
, Qunbound
))
627 /* A Qt binding is just like an explicit nil binding
628 (i.e. it shadows any parent binding but not bindings in
629 keymaps of lower precedence). */
631 val
= get_keyelt (val
, autoload
);
633 fix_submap_inheritance (map
, idx
, val
);
634 RETURN_UNGCPRO (val
);
639 return get_keyelt (t_binding
, autoload
);
643 /* Given OBJECT which was found in a slot in a keymap,
644 trace indirect definitions to get the actual definition of that slot.
645 An indirect definition is a list of the form
646 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
647 and INDEX is the object to look up in KEYMAP to yield the definition.
649 Also if OBJECT has a menu string as the first element,
650 remove that. Also remove a menu help string as second element.
652 If AUTOLOAD is nonzero, load autoloadable keymaps
653 that are referred to with indirection. */
656 get_keyelt (object
, autoload
)
662 if (!(CONSP (object
)))
663 /* This is really the value. */
666 /* If the keymap contents looks like (keymap ...) or (lambda ...)
668 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
671 /* If the keymap contents looks like (menu-item name . DEFN)
672 or (menu-item name DEFN ...) then use DEFN.
673 This is a new format menu item. */
674 else if (EQ (XCAR (object
), Qmenu_item
))
676 if (CONSP (XCDR (object
)))
680 object
= XCDR (XCDR (object
));
683 object
= XCAR (object
);
685 /* If there's a `:filter FILTER', apply FILTER to the
686 menu-item's definition to get the real definition to
688 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
689 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
692 filter
= XCAR (XCDR (tem
));
693 filter
= list2 (filter
, list2 (Qquote
, object
));
694 object
= menu_item_eval_property (filter
);
699 /* Invalid keymap. */
703 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
704 Keymap alist elements like (CHAR MENUSTRING . DEFN)
705 will be used by HierarKey menus. */
706 else if (STRINGP (XCAR (object
)))
708 object
= XCDR (object
);
709 /* Also remove a menu help string, if any,
710 following the menu item name. */
711 if (CONSP (object
) && STRINGP (XCAR (object
)))
712 object
= XCDR (object
);
713 /* Also remove the sublist that caches key equivalences, if any. */
714 if (CONSP (object
) && CONSP (XCAR (object
)))
717 carcar
= XCAR (XCAR (object
));
718 if (NILP (carcar
) || VECTORP (carcar
))
719 object
= XCDR (object
);
723 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
729 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
731 return (!CONSP (map
) ? object
/* Invalid keymap */
732 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
738 store_in_keymap (keymap
, idx
, def
)
740 register Lisp_Object idx
;
741 register Lisp_Object def
;
743 /* Flush any reverse-map cache. */
744 where_is_cache
= Qnil
;
745 where_is_cache_keymaps
= Qt
;
747 /* If we are preparing to dump, and DEF is a menu element
748 with a menu item indicator, copy it to ensure it is not pure. */
749 if (CONSP (def
) && PURE_P (def
)
750 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
751 def
= Fcons (XCAR (def
), XCDR (def
));
753 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
754 error ("attempt to define a key in a non-keymap");
756 /* If idx is a list (some sort of mouse click, perhaps?),
757 the index we want to use is the car of the list, which
758 ought to be a symbol. */
759 idx
= EVENT_HEAD (idx
);
761 /* If idx is a symbol, it might have modifiers, which need to
762 be put in the canonical order. */
764 idx
= reorder_modifiers (idx
);
765 else if (INTEGERP (idx
))
766 /* Clobber the high bits that can be present on a machine
767 with more than 24 bits of integer. */
768 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
770 /* Scan the keymap for a binding of idx. */
774 /* The cons after which we should insert new bindings. If the
775 keymap has a table element, we record its position here, so new
776 bindings will go after it; this way, the table will stay
777 towards the front of the alist and character lookups in dense
778 keymaps will remain fast. Otherwise, this just points at the
779 front of the keymap. */
780 Lisp_Object insertion_point
;
782 insertion_point
= keymap
;
783 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
790 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
792 ASET (elt
, XFASTINT (idx
), def
);
795 insertion_point
= tail
;
797 else if (CHAR_TABLE_P (elt
))
799 /* Character codes with modifiers
800 are not included in a char-table.
801 All character codes without modifiers are included. */
802 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
805 /* `nil' has a special meaning for char-tables, so
806 we use something else to record an explicitly
808 NILP (def
) ? Qt
: def
);
811 insertion_point
= tail
;
813 else if (CONSP (elt
))
815 if (EQ (idx
, XCAR (elt
)))
821 else if (EQ (elt
, Qkeymap
))
822 /* If we find a 'keymap' symbol in the spine of KEYMAP,
823 then we must have found the start of a second keymap
824 being used as the tail of KEYMAP, and a binding for IDX
825 should be inserted before it. */
832 /* We have scanned the entire keymap, and not found a binding for
833 IDX. Let's add one. */
834 XSETCDR (insertion_point
,
835 Fcons (Fcons (idx
, def
), XCDR (insertion_point
)));
841 EXFUN (Fcopy_keymap
, 1);
844 copy_keymap_item (elt
)
847 Lisp_Object res
, tem
;
854 /* Is this a new format menu item. */
855 if (EQ (XCAR (tem
), Qmenu_item
))
857 /* Copy cell with menu-item marker. */
858 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
862 /* Copy cell with menu-item name. */
863 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
869 /* Copy cell with binding and if the binding is a keymap,
871 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
874 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
875 XSETCAR (elt
, Fcopy_keymap (tem
));
877 if (CONSP (tem
) && CONSP (XCAR (tem
)))
878 /* Delete cache for key equivalences. */
879 XSETCDR (elt
, XCDR (tem
));
884 /* It may be an old fomat menu item.
885 Skip the optional menu string. */
886 if (STRINGP (XCAR (tem
)))
888 /* Copy the cell, since copy-alist didn't go this deep. */
889 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
891 /* Also skip the optional menu help string. */
892 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
894 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
898 /* There may also be a list that caches key equivalences.
899 Just delete it for the new keymap. */
901 && CONSP (XCAR (tem
))
902 && (NILP (XCAR (XCAR (tem
)))
903 || VECTORP (XCAR (XCAR (tem
)))))
905 XSETCDR (elt
, XCDR (tem
));
908 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
909 XSETCDR (elt
, Fcopy_keymap (tem
));
911 else if (EQ (XCAR (tem
), Qkeymap
))
912 res
= Fcopy_keymap (elt
);
918 copy_keymap_1 (chartable
, idx
, elt
)
919 Lisp_Object chartable
, idx
, elt
;
921 Faset (chartable
, idx
, copy_keymap_item (elt
));
924 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
925 doc
: /* Return a copy of the keymap KEYMAP.
926 The copy starts out with the same definitions of KEYMAP,
927 but changing either the copy or KEYMAP does not affect the other.
928 Any key definitions that are subkeymaps are recursively copied.
929 However, a key definition which is a symbol whose definition is a keymap
934 register Lisp_Object copy
, tail
;
935 keymap
= get_keymap (keymap
, 1, 0);
936 copy
= tail
= Fcons (Qkeymap
, Qnil
);
937 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
939 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
941 Lisp_Object elt
= XCAR (keymap
);
942 if (CHAR_TABLE_P (elt
))
944 Lisp_Object indices
[3];
945 elt
= Fcopy_sequence (elt
);
946 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, 0, indices
);
948 else if (VECTORP (elt
))
951 elt
= Fcopy_sequence (elt
);
952 for (i
= 0; i
< ASIZE (elt
); i
++)
953 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
955 else if (CONSP (elt
))
956 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
957 XSETCDR (tail
, Fcons (elt
, Qnil
));
959 keymap
= XCDR (keymap
);
961 XSETCDR (tail
, keymap
);
965 /* Simple Keymap mutators and accessors. */
967 /* GC is possible in this function if it autoloads a keymap. */
969 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
970 doc
: /* In KEYMAP, define key sequence KEY as DEF.
973 KEY is a string or a vector of symbols and characters meaning a
974 sequence of keystrokes and events. Non-ASCII characters with codes
975 above 127 (such as ISO Latin-1) can be included if you use a vector.
976 Using [t] for KEY creates a default definition, which applies to any
977 event type that has no other definition in this keymap.
979 DEF is anything that can be a key's definition:
980 nil (means key is undefined in this keymap),
981 a command (a Lisp function suitable for interactive calling)
982 a string (treated as a keyboard macro),
983 a keymap (to define a prefix key),
984 a symbol. When the key is looked up, the symbol will stand for its
985 function definition, which should at that time be one of the above,
986 or another symbol whose function definition is used, etc.
987 a cons (STRING . DEFN), meaning that DEFN is the definition
988 (DEFN should be a valid definition in its own right),
989 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
991 If KEYMAP is a sparse keymap with a binding for KEY, the existing
992 binding is altered. If there is no binding for KEY, the new pair
993 binding KEY to DEF is added at the front of KEYMAP. */)
1000 register Lisp_Object c
;
1001 register Lisp_Object cmd
;
1005 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1007 GCPRO3 (keymap
, key
, def
);
1008 keymap
= get_keymap (keymap
, 1, 1);
1010 if (!VECTORP (key
) && !STRINGP (key
))
1011 key
= wrong_type_argument (Qarrayp
, key
);
1013 length
= XFASTINT (Flength (key
));
1015 RETURN_UNGCPRO (Qnil
);
1017 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1018 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1020 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1025 c
= Faref (key
, make_number (idx
));
1027 if (CONSP (c
) && lucid_event_type_list_p (c
))
1028 c
= Fevent_convert_list (c
);
1031 silly_event_symbol_error (c
);
1034 && (XINT (c
) & meta_bit
)
1037 c
= meta_prefix_char
;
1043 XSETINT (c
, XINT (c
) & ~meta_bit
);
1049 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
))
1050 error ("Key sequence contains invalid event");
1053 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1055 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1057 /* If this key is undefined, make it a prefix. */
1059 cmd
= define_as_prefix (keymap
, c
);
1061 keymap
= get_keymap (cmd
, 0, 1);
1062 if (!CONSP (keymap
))
1063 /* We must use Fkey_description rather than just passing key to
1064 error; key might be a vector, not a string. */
1065 error ("Key sequence %s uses invalid prefix characters",
1066 SDATA (Fkey_description (key
)));
1070 /* This function may GC (it calls Fkey_binding). */
1072 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1073 doc
: /* Return the remapping for command COMMAND in current keymaps.
1074 Returns nil if COMMAND is not remapped (or not a symbol). */)
1076 Lisp_Object command
;
1078 if (!SYMBOLP (command
))
1081 ASET (command_remapping_vector
, 1, command
);
1082 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1085 /* Value is number if KEY is too long; nil if valid but has no definition. */
1086 /* GC is possible in this function if it autoloads a keymap. */
1088 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1089 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1090 nil means undefined. See doc of `define-key' for kinds of definitions.
1092 A number as value means KEY is "too long";
1093 that is, characters or symbols in it except for the last one
1094 fail to be a valid sequence of prefix characters in KEYMAP.
1095 The number is how many characters at the front of KEY
1096 it takes to reach a non-prefix command.
1098 Normally, `lookup-key' ignores bindings for t, which act as default
1099 bindings, used when nothing else in the keymap applies; this makes it
1100 usable as a general function for probing keymaps. However, if the
1101 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1102 recognize the default bindings, just as `read-key-sequence' does. */)
1103 (keymap
, key
, accept_default
)
1106 Lisp_Object accept_default
;
1109 register Lisp_Object cmd
;
1110 register Lisp_Object c
;
1112 int t_ok
= !NILP (accept_default
);
1113 struct gcpro gcpro1
, gcpro2
;
1115 GCPRO2 (keymap
, key
);
1116 keymap
= get_keymap (keymap
, 1, 1);
1118 if (!VECTORP (key
) && !STRINGP (key
))
1119 key
= wrong_type_argument (Qarrayp
, key
);
1121 length
= XFASTINT (Flength (key
));
1123 RETURN_UNGCPRO (keymap
);
1128 c
= Faref (key
, make_number (idx
++));
1130 if (CONSP (c
) && lucid_event_type_list_p (c
))
1131 c
= Fevent_convert_list (c
);
1133 /* Turn the 8th bit of string chars into a meta modifier. */
1134 if (XINT (c
) & 0x80 && STRINGP (key
))
1135 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1137 /* Allow string since binding for `menu-bar-select-buffer'
1138 includes the buffer name in the key sequence. */
1139 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1140 error ("Key sequence contains invalid event");
1142 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1144 RETURN_UNGCPRO (cmd
);
1146 keymap
= get_keymap (cmd
, 0, 1);
1147 if (!CONSP (keymap
))
1148 RETURN_UNGCPRO (make_number (idx
));
1154 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1155 Assume that currently it does not define C at all.
1156 Return the keymap. */
1159 define_as_prefix (keymap
, c
)
1160 Lisp_Object keymap
, c
;
1164 cmd
= Fmake_sparse_keymap (Qnil
);
1165 /* If this key is defined as a prefix in an inherited keymap,
1166 make it a prefix in this map, and make its definition
1167 inherit the other prefix definition. */
1168 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1169 store_in_keymap (keymap
, c
, cmd
);
1174 /* Append a key to the end of a key sequence. We always make a vector. */
1177 append_key (key_sequence
, key
)
1178 Lisp_Object key_sequence
, key
;
1180 Lisp_Object args
[2];
1182 args
[0] = key_sequence
;
1184 args
[1] = Fcons (key
, Qnil
);
1185 return Fvconcat (2, args
);
1188 /* Given a event type C which is a symbol,
1189 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1192 silly_event_symbol_error (c
)
1195 Lisp_Object parsed
, base
, name
, assoc
;
1198 parsed
= parse_modifiers (c
);
1199 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1200 base
= XCAR (parsed
);
1201 name
= Fsymbol_name (base
);
1202 /* This alist includes elements such as ("RET" . "\\r"). */
1203 assoc
= Fassoc (name
, exclude_keys
);
1207 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1209 Lisp_Object keystring
;
1210 if (modifiers
& alt_modifier
)
1211 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1212 if (modifiers
& ctrl_modifier
)
1213 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1214 if (modifiers
& hyper_modifier
)
1215 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1216 if (modifiers
& meta_modifier
)
1217 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1218 if (modifiers
& shift_modifier
)
1219 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1220 if (modifiers
& super_modifier
)
1221 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1224 c
= reorder_modifiers (c
);
1225 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1227 error ((modifiers
& ~meta_modifier
1228 ? "To bind the key %s, use [?%s], not [%s]"
1229 : "To bind the key %s, use \"%s\", not [%s]"),
1230 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1231 SDATA (SYMBOL_NAME (c
)));
1235 /* Global, local, and minor mode keymap stuff. */
1237 /* We can't put these variables inside current_minor_maps, since under
1238 some systems, static gets macro-defined to be the empty string.
1240 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1241 static int cmm_size
= 0;
1243 /* Error handler used in current_minor_maps. */
1245 current_minor_maps_error ()
1250 /* Store a pointer to an array of the keymaps of the currently active
1251 minor modes in *buf, and return the number of maps it contains.
1253 This function always returns a pointer to the same buffer, and may
1254 free or reallocate it, so if you want to keep it for a long time or
1255 hand it out to lisp code, copy it. This procedure will be called
1256 for every key sequence read, so the nice lispy approach (return a
1257 new assoclist, list, what have you) for each invocation would
1258 result in a lot of consing over time.
1260 If we used xrealloc/xmalloc and ran out of memory, they would throw
1261 back to the command loop, which would try to read a key sequence,
1262 which would call this function again, resulting in an infinite
1263 loop. Instead, we'll use realloc/malloc and silently truncate the
1264 list, let the key sequence be read, and hope some other piece of
1265 code signals the error. */
1267 current_minor_maps (modeptr
, mapptr
)
1268 Lisp_Object
**modeptr
, **mapptr
;
1271 int list_number
= 0;
1272 Lisp_Object alist
, assoc
, var
, val
;
1273 Lisp_Object emulation_alists
;
1274 Lisp_Object lists
[2];
1276 emulation_alists
= Vemulation_mode_map_alists
;
1277 lists
[0] = Vminor_mode_overriding_map_alist
;
1278 lists
[1] = Vminor_mode_map_alist
;
1280 for (list_number
= 0; list_number
< 2; list_number
++)
1282 if (CONSP (emulation_alists
))
1284 alist
= XCAR (emulation_alists
);
1285 emulation_alists
= XCDR (emulation_alists
);
1286 if (SYMBOLP (alist
))
1287 alist
= find_symbol_value (alist
);
1291 alist
= lists
[list_number
];
1293 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1294 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1295 && (var
= XCAR (assoc
), SYMBOLP (var
))
1296 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1301 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1302 and also an entry in Vminor_mode_map_alist,
1303 ignore the latter. */
1304 if (list_number
== 1)
1306 val
= assq_no_quit (var
, lists
[0]);
1313 int newsize
, allocsize
;
1314 Lisp_Object
*newmodes
, *newmaps
;
1316 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1317 allocsize
= newsize
* sizeof *newmodes
;
1319 /* Use malloc here. See the comment above this function.
1320 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1322 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1327 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1330 cmm_modes
= newmodes
;
1333 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1338 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1345 if (newmodes
== NULL
|| newmaps
== NULL
)
1350 /* Get the keymap definition--or nil if it is not defined. */
1351 temp
= internal_condition_case_1 (Findirect_function
,
1353 Qerror
, current_minor_maps_error
);
1357 cmm_maps
[i
] = temp
;
1363 if (modeptr
) *modeptr
= cmm_modes
;
1364 if (mapptr
) *mapptr
= cmm_maps
;
1368 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1370 doc
: /* Return a list of the currently active keymaps.
1371 OLP if non-nil indicates that we should obey `overriding-local-map' and
1372 `overriding-terminal-local-map'. */)
1376 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1380 if (!NILP (Voverriding_local_map
))
1381 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1382 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1383 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1385 if (NILP (XCDR (keymaps
)))
1391 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1393 keymaps
= Fcons (local
, keymaps
);
1395 nmaps
= current_minor_maps (0, &maps
);
1397 for (i
= --nmaps
; i
>= 0; i
--)
1398 if (!NILP (maps
[i
]))
1399 keymaps
= Fcons (maps
[i
], keymaps
);
1401 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1403 keymaps
= Fcons (local
, keymaps
);
1409 /* GC is possible in this function if it autoloads a keymap. */
1411 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1412 doc
: /* Return the binding for command KEY in current keymaps.
1413 KEY is a string or vector, a sequence of keystrokes.
1414 The binding is probably a symbol with a function definition.
1416 Normally, `key-binding' ignores bindings for t, which act as default
1417 bindings, used when nothing else in the keymap applies; this makes it
1418 usable as a general function for probing keymaps. However, if the
1419 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1420 recognize the default bindings, just as `read-key-sequence' does.
1422 Like the normal command loop, `key-binding' will remap the command
1423 resulting from looking up KEY by looking up the command in the
1424 current keymaps. However, if the optional third argument NO-REMAP
1425 is non-nil, `key-binding' returns the unmapped command. */)
1426 (key
, accept_default
, no_remap
)
1427 Lisp_Object key
, accept_default
, no_remap
;
1429 Lisp_Object
*maps
, value
;
1431 struct gcpro gcpro1
;
1435 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1437 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1438 key
, accept_default
);
1439 if (! NILP (value
) && !INTEGERP (value
))
1442 else if (!NILP (Voverriding_local_map
))
1444 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1445 if (! NILP (value
) && !INTEGERP (value
))
1452 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1455 value
= Flookup_key (local
, key
, accept_default
);
1456 if (! NILP (value
) && !INTEGERP (value
))
1460 nmaps
= current_minor_maps (0, &maps
);
1461 /* Note that all these maps are GCPRO'd
1462 in the places where we found them. */
1464 for (i
= 0; i
< nmaps
; i
++)
1465 if (! NILP (maps
[i
]))
1467 value
= Flookup_key (maps
[i
], key
, accept_default
);
1468 if (! NILP (value
) && !INTEGERP (value
))
1472 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1475 value
= Flookup_key (local
, key
, accept_default
);
1476 if (! NILP (value
) && !INTEGERP (value
))
1481 value
= Flookup_key (current_global_map
, key
, accept_default
);
1485 if (NILP (value
) || INTEGERP (value
))
1488 /* If the result of the ordinary keymap lookup is an interactive
1489 command, look for a key binding (ie. remapping) for that command. */
1491 if (NILP (no_remap
) && SYMBOLP (value
))
1494 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1501 /* GC is possible in this function if it autoloads a keymap. */
1503 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1504 doc
: /* Return the binding for command KEYS in current local keymap only.
1505 KEYS is a string, a sequence of keystrokes.
1506 The binding is probably a symbol with a function definition.
1508 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1509 bindings; see the description of `lookup-key' for more details about this. */)
1510 (keys
, accept_default
)
1511 Lisp_Object keys
, accept_default
;
1513 register Lisp_Object map
;
1514 map
= current_buffer
->keymap
;
1517 return Flookup_key (map
, keys
, accept_default
);
1520 /* GC is possible in this function if it autoloads a keymap. */
1522 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1523 doc
: /* Return the binding for command KEYS in current global keymap only.
1524 KEYS is a string, a sequence of keystrokes.
1525 The binding is probably a symbol with a function definition.
1526 This function's return values are the same as those of lookup-key
1529 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1530 bindings; see the description of `lookup-key' for more details about this. */)
1531 (keys
, accept_default
)
1532 Lisp_Object keys
, accept_default
;
1534 return Flookup_key (current_global_map
, keys
, accept_default
);
1537 /* GC is possible in this function if it autoloads a keymap. */
1539 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1540 doc
: /* Find the visible minor mode bindings of KEY.
1541 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1542 the symbol which names the minor mode binding KEY, and BINDING is
1543 KEY's definition in that mode. In particular, if KEY has no
1544 minor-mode bindings, return nil. If the first binding is a
1545 non-prefix, all subsequent bindings will be omitted, since they would
1546 be ignored. Similarly, the list doesn't include non-prefix bindings
1547 that come after prefix bindings.
1549 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1550 bindings; see the description of `lookup-key' for more details about this. */)
1551 (key
, accept_default
)
1552 Lisp_Object key
, accept_default
;
1554 Lisp_Object
*modes
, *maps
;
1556 Lisp_Object binding
;
1558 struct gcpro gcpro1
, gcpro2
;
1560 nmaps
= current_minor_maps (&modes
, &maps
);
1561 /* Note that all these maps are GCPRO'd
1562 in the places where we found them. */
1565 GCPRO2 (key
, binding
);
1567 for (i
= j
= 0; i
< nmaps
; i
++)
1569 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1570 && !INTEGERP (binding
))
1572 if (KEYMAPP (binding
))
1573 maps
[j
++] = Fcons (modes
[i
], binding
);
1575 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1579 return Flist (j
, maps
);
1582 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1583 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1584 A new sparse keymap is stored as COMMAND's function definition and its value.
1585 If a second optional argument MAPVAR is given, the map is stored as
1586 its value instead of as COMMAND's value; but COMMAND is still defined
1588 The third optional argument NAME, if given, supplies a menu name
1589 string for the map. This is required to use the keymap as a menu. */)
1590 (command
, mapvar
, name
)
1591 Lisp_Object command
, mapvar
, name
;
1594 map
= Fmake_sparse_keymap (name
);
1595 Ffset (command
, map
);
1599 Fset (command
, map
);
1603 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1604 doc
: /* Select KEYMAP as the global keymap. */)
1608 keymap
= get_keymap (keymap
, 1, 1);
1609 current_global_map
= keymap
;
1614 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1615 doc
: /* Select KEYMAP as the local keymap.
1616 If KEYMAP is nil, that means no local keymap. */)
1621 keymap
= get_keymap (keymap
, 1, 1);
1623 current_buffer
->keymap
= keymap
;
1628 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1629 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1632 return current_buffer
->keymap
;
1635 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1636 doc
: /* Return the current global keymap. */)
1639 return current_global_map
;
1642 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1643 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1647 int nmaps
= current_minor_maps (0, &maps
);
1649 return Flist (nmaps
, maps
);
1652 /* Help functions for describing and documenting keymaps. */
1656 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1657 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1658 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1662 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1666 /* Look for and break cycles. */
1667 while (!NILP (tem
= Frassq (cmd
, maps
)))
1669 Lisp_Object prefix
= XCAR (tem
);
1670 int lim
= XINT (Flength (XCAR (tem
)));
1671 if (lim
<= XINT (Flength (thisseq
)))
1672 { /* This keymap was already seen with a smaller prefix. */
1674 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1675 Faref (thisseq
, make_number (i
))))
1678 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1681 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1682 but maybe `cmd' occurs again further down in `maps', so keep
1684 maps
= XCDR (Fmemq (tem
, maps
));
1687 /* If the last key in thisseq is meta-prefix-char,
1688 turn it into a meta-ized keystroke. We know
1689 that the event we're about to append is an
1690 ascii keystroke since we're processing a
1694 int meta_bit
= meta_modifier
;
1695 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1696 tem
= Fcopy_sequence (thisseq
);
1698 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1700 /* This new sequence is the same length as
1701 thisseq, so stick it in the list right
1704 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1708 tem
= append_key (thisseq
, key
);
1709 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1714 accessible_keymaps_char_table (args
, index
, cmd
)
1715 Lisp_Object args
, index
, cmd
;
1717 accessible_keymaps_1 (index
, cmd
,
1721 XINT (XCDR (XCAR (args
))));
1724 /* This function cannot GC. */
1726 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1728 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1729 Returns a list of elements of the form (KEYS . MAP), where the sequence
1730 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1731 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1732 An optional argument PREFIX, if non-nil, should be a key sequence;
1733 then the value includes only maps for prefixes that start with PREFIX. */)
1735 Lisp_Object keymap
, prefix
;
1737 Lisp_Object maps
, tail
;
1740 /* no need for gcpro because we don't autoload any keymaps. */
1743 prefixlen
= XINT (Flength (prefix
));
1747 /* If a prefix was specified, start with the keymap (if any) for
1748 that prefix, so we don't waste time considering other prefixes. */
1750 tem
= Flookup_key (keymap
, prefix
, Qt
);
1751 /* Flookup_key may give us nil, or a number,
1752 if the prefix is not defined in this particular map.
1753 It might even give us a list that isn't a keymap. */
1754 tem
= get_keymap (tem
, 0, 0);
1757 /* Convert PREFIX to a vector now, so that later on
1758 we don't have to deal with the possibility of a string. */
1759 if (STRINGP (prefix
))
1764 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1765 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1769 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1770 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1771 c
^= 0200 | meta_modifier
;
1772 ASET (copy
, i_before
, make_number (c
));
1776 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1782 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1783 get_keymap (keymap
, 1, 0)),
1786 /* For each map in the list maps,
1787 look at any other maps it points to,
1788 and stick them at the end if they are not already in the list.
1790 This is a breadth-first traversal, where tail is the queue of
1791 nodes, and maps accumulates a list of all nodes visited. */
1793 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1795 register Lisp_Object thisseq
, thismap
;
1797 /* Does the current sequence end in the meta-prefix-char? */
1800 thisseq
= Fcar (Fcar (tail
));
1801 thismap
= Fcdr (Fcar (tail
));
1802 last
= make_number (XINT (Flength (thisseq
)) - 1);
1803 is_metized
= (XINT (last
) >= 0
1804 /* Don't metize the last char of PREFIX. */
1805 && XINT (last
) >= prefixlen
1806 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1808 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1812 elt
= XCAR (thismap
);
1816 if (CHAR_TABLE_P (elt
))
1818 Lisp_Object indices
[3];
1820 map_char_table (accessible_keymaps_char_table
, Qnil
,
1821 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1822 Fcons (tail
, thisseq
)),
1825 else if (VECTORP (elt
))
1829 /* Vector keymap. Scan all the elements. */
1830 for (i
= 0; i
< ASIZE (elt
); i
++)
1831 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1832 maps
, tail
, thisseq
, is_metized
);
1835 else if (CONSP (elt
))
1836 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1837 maps
, tail
, thisseq
,
1838 is_metized
&& INTEGERP (XCAR (elt
)));
1846 Lisp_Object Qsingle_key_description
, Qkey_description
;
1848 /* This function cannot GC. */
1850 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1851 doc
: /* Return a pretty description of key-sequence KEYS.
1852 Control characters turn into "C-foo" sequences, meta into "M-foo"
1853 spaces are put between sequence elements, etc. */)
1860 Lisp_Object
*args
= NULL
;
1865 vector
= Fmake_vector (Flength (keys
), Qnil
);
1866 for (i
= 0, i_byte
= 0; i
< SCHARS (keys
); )
1871 FETCH_STRING_CHAR_ADVANCE (c
, keys
, i
, i_byte
);
1872 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1873 c
^= 0200 | meta_modifier
;
1874 XSETFASTINT (AREF (vector
, i_before
), c
);
1881 /* In effect, this computes
1882 (mapconcat 'single-key-description keys " ")
1883 but we shouldn't use mapconcat because it can do GC. */
1885 len
= XVECTOR (keys
)->size
;
1886 sep
= build_string (" ");
1887 /* This has one extra element at the end that we don't pass to Fconcat. */
1888 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1890 for (i
= 0; i
< len
; i
++)
1892 args
[i
* 2] = Fsingle_key_description (AREF (keys
, i
), Qnil
);
1893 args
[i
* 2 + 1] = sep
;
1896 else if (CONSP (keys
))
1898 /* In effect, this computes
1899 (mapconcat 'single-key-description keys " ")
1900 but we shouldn't use mapconcat because it can do GC. */
1902 len
= XFASTINT (Flength (keys
));
1903 sep
= build_string (" ");
1904 /* This has one extra element at the end that we don't pass to Fconcat. */
1905 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1907 for (i
= 0; i
< len
; i
++)
1909 args
[i
* 2] = Fsingle_key_description (XCAR (keys
), Qnil
);
1910 args
[i
* 2 + 1] = sep
;
1915 keys
= wrong_type_argument (Qarrayp
, keys
);
1918 return empty_string
;
1919 return Fconcat (len
* 2 - 1, args
);
1923 push_key_description (c
, p
, force_multibyte
)
1924 register unsigned int c
;
1926 int force_multibyte
;
1930 /* Clear all the meaningless bits above the meta bit. */
1931 c
&= meta_modifier
| ~ - meta_modifier
;
1932 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
1933 | meta_modifier
| shift_modifier
| super_modifier
);
1935 if (c
& alt_modifier
)
1941 if ((c
& ctrl_modifier
) != 0
1942 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
1946 c
&= ~ctrl_modifier
;
1948 if (c
& hyper_modifier
)
1952 c
-= hyper_modifier
;
1954 if (c
& meta_modifier
)
1960 if (c
& shift_modifier
)
1964 c
-= shift_modifier
;
1966 if (c
& super_modifier
)
1970 c
-= super_modifier
;
1986 else if (c
== Ctl ('M'))
1994 /* `C-' already added above. */
1995 if (c
> 0 && c
<= Ctl ('Z'))
2014 || (NILP (current_buffer
->enable_multibyte_characters
)
2015 && SINGLE_BYTE_CHAR_P (c
)
2016 && !force_multibyte
))
2022 int valid_p
= SINGLE_BYTE_CHAR_P (c
) || char_valid_p (c
, 0);
2024 if (force_multibyte
&& valid_p
)
2026 if (SINGLE_BYTE_CHAR_P (c
))
2027 c
= unibyte_char_to_multibyte (c
);
2028 p
+= CHAR_STRING (c
, p
);
2030 else if (NILP (current_buffer
->enable_multibyte_characters
)
2035 /* The biggest character code uses 19 bits. */
2036 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
2038 if (c
>= (1 << bit_offset
))
2039 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2043 p
+= CHAR_STRING (c
, p
);
2049 /* This function cannot GC. */
2051 DEFUN ("single-key-description", Fsingle_key_description
,
2052 Ssingle_key_description
, 1, 2, 0,
2053 doc
: /* Return a pretty description of command character KEY.
2054 Control characters turn into C-whatever, etc.
2055 Optional argument NO-ANGLES non-nil means don't put angle brackets
2056 around function keys and event symbols. */)
2058 Lisp_Object key
, no_angles
;
2060 if (CONSP (key
) && lucid_event_type_list_p (key
))
2061 key
= Fevent_convert_list (key
);
2063 key
= EVENT_HEAD (key
);
2065 if (INTEGERP (key
)) /* Normal character */
2067 unsigned int charset
, c1
, c2
;
2068 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
2070 if (SINGLE_BYTE_CHAR_P (without_bits
))
2073 SPLIT_CHAR (without_bits
, charset
, c1
, c2
);
2076 && CHARSET_DEFINED_P (charset
)
2077 && ((c1
>= 0 && c1
< 32)
2078 || (c2
>= 0 && c2
< 32)))
2080 /* Handle a generic character. */
2082 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
2083 CHECK_STRING (name
);
2084 return concat2 (build_string ("Character set "), name
);
2088 char tem
[KEY_DESCRIPTION_SIZE
], *end
;
2092 end
= push_key_description (XUINT (key
), tem
, 1);
2094 nchars
= multibyte_chars_in_text (tem
, nbytes
);
2095 if (nchars
== nbytes
)
2098 string
= build_string (tem
);
2101 string
= make_multibyte_string (tem
, nchars
, nbytes
);
2105 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2107 if (NILP (no_angles
))
2110 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2111 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2112 return build_string (buffer
);
2115 return Fsymbol_name (key
);
2117 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2118 return Fcopy_sequence (key
);
2120 error ("KEY must be an integer, cons, symbol, or string");
2125 push_text_char_description (c
, p
)
2126 register unsigned int c
;
2138 *p
++ = c
+ 64; /* 'A' - 1 */
2150 /* This function cannot GC. */
2152 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2153 doc
: /* Return a pretty description of file-character CHARACTER.
2154 Control characters turn into "^char", etc. */)
2156 Lisp_Object character
;
2158 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2159 unsigned char str
[6];
2162 CHECK_NUMBER (character
);
2164 c
= XINT (character
);
2165 if (!SINGLE_BYTE_CHAR_P (c
))
2167 int len
= CHAR_STRING (c
, str
);
2169 return make_multibyte_string (str
, 1, len
);
2172 *push_text_char_description (c
& 0377, str
) = 0;
2174 return build_string (str
);
2177 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2180 ascii_sequence_p (seq
)
2184 int len
= XINT (Flength (seq
));
2186 for (i
= 0; i
< len
; i
++)
2188 Lisp_Object ii
, elt
;
2190 XSETFASTINT (ii
, i
);
2191 elt
= Faref (seq
, ii
);
2194 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2202 /* where-is - finding a command in a set of keymaps. */
2204 static Lisp_Object
where_is_internal ();
2205 static Lisp_Object
where_is_internal_1 ();
2206 static void where_is_internal_2 ();
2208 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2209 Returns the first non-nil binding found in any of those maps. */
2212 shadow_lookup (shadow
, key
, flag
)
2213 Lisp_Object shadow
, key
, flag
;
2215 Lisp_Object tail
, value
;
2217 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2219 value
= Flookup_key (XCAR (tail
), key
, flag
);
2220 if (!NILP (value
) && !NATNUMP (value
))
2226 static Lisp_Object Vmenu_events
;
2228 /* This function can GC if Flookup_key autoloads any keymaps. */
2231 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2232 Lisp_Object definition
, keymaps
;
2233 Lisp_Object firstonly
, noindirect
, no_remap
;
2235 Lisp_Object maps
= Qnil
;
2236 Lisp_Object found
, sequences
;
2237 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2238 /* 1 means ignore all menu bindings entirely. */
2239 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2241 /* If this command is remapped, then it has no key bindings
2243 if (NILP (no_remap
) && SYMBOLP (definition
))
2246 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2251 while (CONSP (found
))
2255 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2256 found
= XCDR (found
);
2259 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2263 for (; !NILP (maps
); maps
= Fcdr (maps
))
2265 /* Key sequence to reach map, and the map that it reaches */
2266 register Lisp_Object
this, map
, tem
;
2268 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2269 [M-CHAR] sequences, check if last character of the sequence
2270 is the meta-prefix char. */
2274 this = Fcar (Fcar (maps
));
2275 map
= Fcdr (Fcar (maps
));
2276 last
= make_number (XINT (Flength (this)) - 1);
2277 last_is_meta
= (XINT (last
) >= 0
2278 && EQ (Faref (this, last
), meta_prefix_char
));
2280 /* if (nomenus && !ascii_sequence_p (this)) */
2281 if (nomenus
&& XINT (last
) >= 0
2282 && SYMBOLP (tem
= Faref (this, make_number (0)))
2283 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmenu_events
)))
2284 /* If no menu entries should be returned, skip over the
2285 keymaps bound to `menu-bar' and `tool-bar' and other
2286 non-ascii prefixes like `C-down-mouse-2'. */
2293 /* Because the code we want to run on each binding is rather
2294 large, we don't want to have two separate loop bodies for
2295 sparse keymap bindings and tables; we want to iterate one
2296 loop body over both keymap and vector bindings.
2298 For this reason, if Fcar (map) is a vector, we don't
2299 advance map to the next element until i indicates that we
2300 have finished off the vector. */
2301 Lisp_Object elt
, key
, binding
;
2309 /* Set key and binding to the current key and binding, and
2310 advance map and i to the next binding. */
2313 Lisp_Object sequence
;
2315 /* In a vector, look at each element. */
2316 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2318 binding
= AREF (elt
, i
);
2319 XSETFASTINT (key
, i
);
2320 sequence
= where_is_internal_1 (binding
, key
, definition
,
2322 last
, nomenus
, last_is_meta
);
2323 if (!NILP (sequence
))
2324 sequences
= Fcons (sequence
, sequences
);
2327 else if (CHAR_TABLE_P (elt
))
2329 Lisp_Object indices
[3];
2332 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2333 Qnil
), /* Result accumulator. */
2334 Fcons (Fcons (this, last
),
2335 Fcons (make_number (nomenus
),
2336 make_number (last_is_meta
))));
2337 map_char_table (where_is_internal_2
, Qnil
, elt
, args
,
2339 sequences
= XCDR (XCAR (args
));
2341 else if (CONSP (elt
))
2343 Lisp_Object sequence
;
2346 binding
= XCDR (elt
);
2348 sequence
= where_is_internal_1 (binding
, key
, definition
,
2350 last
, nomenus
, last_is_meta
);
2351 if (!NILP (sequence
))
2352 sequences
= Fcons (sequence
, sequences
);
2356 while (!NILP (sequences
))
2358 Lisp_Object sequence
, remapped
, function
;
2360 sequence
= XCAR (sequences
);
2361 sequences
= XCDR (sequences
);
2363 /* If the current sequence is a command remapping with
2364 format [remap COMMAND], find the key sequences
2365 which run COMMAND, and use those sequences instead. */
2368 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2369 && EQ (AREF (sequence
, 0), Qremap
)
2370 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2372 Lisp_Object remapped1
;
2374 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2375 if (CONSP (remapped1
))
2377 /* Verify that this key binding actually maps to the
2378 remapped command (see below). */
2379 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2381 sequence
= XCAR (remapped1
);
2382 remapped
= XCDR (remapped1
);
2383 goto record_sequence
;
2387 /* Verify that this key binding is not shadowed by another
2388 binding for the same key, before we say it exists.
2390 Mechanism: look for local definition of this key and if
2391 it is defined and does not match what we found then
2394 Either nil or number as value from Flookup_key
2396 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2400 /* It is a true unshadowed match. Record it, unless it's already
2401 been seen (as could happen when inheriting keymaps). */
2402 if (NILP (Fmember (sequence
, found
)))
2403 found
= Fcons (sequence
, found
);
2405 /* If firstonly is Qnon_ascii, then we can return the first
2406 binding we find. If firstonly is not Qnon_ascii but not
2407 nil, then we should return the first ascii-only binding
2409 if (EQ (firstonly
, Qnon_ascii
))
2410 RETURN_UNGCPRO (sequence
);
2411 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2412 RETURN_UNGCPRO (sequence
);
2414 if (CONSP (remapped
))
2416 sequence
= XCAR (remapped
);
2417 remapped
= XCDR (remapped
);
2418 goto record_sequence
;
2426 found
= Fnreverse (found
);
2428 /* firstonly may have been t, but we may have gone all the way through
2429 the keymaps without finding an all-ASCII key sequence. So just
2430 return the best we could find. */
2431 if (!NILP (firstonly
))
2432 return Fcar (found
);
2437 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2438 doc
: /* Return list of keys that invoke DEFINITION.
2439 If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2440 If KEYMAP is nil, search all the currently active keymaps.
2441 If KEYMAP is a list of keymaps, search only those keymaps.
2443 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2444 rather than a list of all possible key sequences.
2445 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2446 no matter what it is.
2447 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
2448 and entirely reject menu bindings.
2450 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2451 to other keymaps or slots. This makes it possible to search for an
2452 indirect definition itself.
2454 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2455 that invoke a command which is remapped to DEFINITION, but include the
2456 remapped command in the returned list. */)
2457 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2458 Lisp_Object definition
, keymap
;
2459 Lisp_Object firstonly
, noindirect
, no_remap
;
2461 Lisp_Object sequences
, keymaps
;
2462 /* 1 means ignore all menu bindings entirely. */
2463 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2466 /* Find the relevant keymaps. */
2467 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2469 else if (!NILP (keymap
))
2470 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2472 keymaps
= Fcurrent_active_maps (Qnil
);
2474 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2475 We don't really need to check `keymap'. */
2476 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2480 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2482 /* Check heuristic-consistency of the cache. */
2483 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2484 where_is_cache
= Qnil
;
2486 if (NILP (where_is_cache
))
2488 /* We need to create the cache. */
2489 Lisp_Object args
[2];
2490 where_is_cache
= Fmake_hash_table (0, args
);
2491 where_is_cache_keymaps
= Qt
;
2493 /* Fill in the cache. */
2494 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2495 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2498 where_is_cache_keymaps
= keymaps
;
2501 /* We want to process definitions from the last to the first.
2502 Instead of consing, copy definitions to a vector and step
2503 over that vector. */
2504 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2505 n
= XINT (Flength (sequences
));
2506 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2507 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2508 defns
[i
++] = XCAR (sequences
);
2510 /* Verify that the key bindings are not shadowed. Note that
2511 the following can GC. */
2512 GCPRO2 (definition
, keymaps
);
2515 for (i
= n
- 1; i
>= 0; --i
)
2516 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2518 if (ascii_sequence_p (defns
[i
]))
2524 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2529 /* Kill the cache so that where_is_internal_1 doesn't think
2530 we're filling it up. */
2531 where_is_cache
= Qnil
;
2532 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2538 /* This is the function that Fwhere_is_internal calls using map_char_table.
2540 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2542 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2543 Since map_char_table doesn't really use the return value from this function,
2544 we the result append to RESULT, the slot in ARGS.
2546 This function can GC because it calls where_is_internal_1 which can
2550 where_is_internal_2 (args
, key
, binding
)
2551 Lisp_Object args
, key
, binding
;
2553 Lisp_Object definition
, noindirect
, this, last
;
2554 Lisp_Object result
, sequence
;
2555 int nomenus
, last_is_meta
;
2556 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2558 GCPRO3 (args
, key
, binding
);
2559 result
= XCDR (XCAR (args
));
2560 definition
= XCAR (XCAR (XCAR (args
)));
2561 noindirect
= XCDR (XCAR (XCAR (args
)));
2562 this = XCAR (XCAR (XCDR (args
)));
2563 last
= XCDR (XCAR (XCDR (args
)));
2564 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2565 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2567 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2568 this, last
, nomenus
, last_is_meta
);
2570 if (!NILP (sequence
))
2571 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2577 /* This function cannot GC. */
2580 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2581 nomenus
, last_is_meta
)
2582 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2583 int nomenus
, last_is_meta
;
2585 Lisp_Object sequence
;
2587 /* Search through indirections unless that's not wanted. */
2588 if (NILP (noindirect
))
2589 binding
= get_keyelt (binding
, 0);
2591 /* End this iteration if this element does not match
2594 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2595 || EQ (binding
, definition
)
2596 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2597 /* Doesn't match. */
2600 /* We have found a match. Construct the key sequence where we found it. */
2601 if (INTEGERP (key
) && last_is_meta
)
2603 sequence
= Fcopy_sequence (this);
2604 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2607 sequence
= append_key (this, key
);
2609 if (!NILP (where_is_cache
))
2611 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2612 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2619 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2621 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2622 doc
: /* Insert the list of all defined keys and their definitions.
2623 The list is inserted in the current buffer, while the bindings are
2624 looked up in BUFFER.
2625 The optional argument PREFIX, if non-nil, should be a key sequence;
2626 then we display only bindings that start with that prefix.
2627 The optional argument MENUS, if non-nil, says to mention menu bindings.
2628 \(Ordinarily these are omitted from the output.) */)
2629 (buffer
, prefix
, menus
)
2630 Lisp_Object buffer
, prefix
, menus
;
2632 Lisp_Object outbuf
, shadow
;
2633 int nomenu
= NILP (menus
);
2634 register Lisp_Object start1
;
2635 struct gcpro gcpro1
;
2637 char *alternate_heading
2639 Keyboard translations:\n\n\
2640 You type Translation\n\
2641 -------- -----------\n";
2646 outbuf
= Fcurrent_buffer ();
2648 /* Report on alternates for keys. */
2649 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2652 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2653 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2655 for (c
= 0; c
< translate_len
; c
++)
2656 if (translate
[c
] != c
)
2658 char buf
[KEY_DESCRIPTION_SIZE
];
2661 if (alternate_heading
)
2663 insert_string (alternate_heading
);
2664 alternate_heading
= 0;
2667 bufend
= push_key_description (translate
[c
], buf
, 1);
2668 insert (buf
, bufend
- buf
);
2669 Findent_to (make_number (16), make_number (1));
2670 bufend
= push_key_description (c
, buf
, 1);
2671 insert (buf
, bufend
- buf
);
2679 if (!NILP (Vkey_translation_map
))
2680 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2681 "Key translations", nomenu
, 1, 0);
2684 /* Print the (major mode) local map. */
2686 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2687 start1
= current_kboard
->Voverriding_terminal_local_map
;
2688 else if (!NILP (Voverriding_local_map
))
2689 start1
= Voverriding_local_map
;
2693 describe_map_tree (start1
, 1, shadow
, prefix
,
2694 "\f\nOverriding Bindings", nomenu
, 0, 0);
2695 shadow
= Fcons (start1
, shadow
);
2699 /* Print the minor mode and major mode keymaps. */
2701 Lisp_Object
*modes
, *maps
;
2703 /* Temporarily switch to `buffer', so that we can get that buffer's
2704 minor modes correctly. */
2705 Fset_buffer (buffer
);
2707 nmaps
= current_minor_maps (&modes
, &maps
);
2708 Fset_buffer (outbuf
);
2710 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2711 XBUFFER (buffer
), Qkeymap
);
2714 describe_map_tree (start1
, 1, shadow
, prefix
,
2715 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2716 shadow
= Fcons (start1
, shadow
);
2719 /* Print the minor mode maps. */
2720 for (i
= 0; i
< nmaps
; i
++)
2722 /* The title for a minor mode keymap
2723 is constructed at run time.
2724 We let describe_map_tree do the actual insertion
2725 because it takes care of other features when doing so. */
2728 if (!SYMBOLP (modes
[i
]))
2731 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2735 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2736 SCHARS (SYMBOL_NAME (modes
[i
])));
2737 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2739 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2740 p
+= sizeof (" Minor Mode Bindings") - 1;
2743 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2744 shadow
= Fcons (maps
[i
], shadow
);
2747 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2748 XBUFFER (buffer
), Qlocal_map
);
2751 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2752 describe_map_tree (start1
, 1, shadow
, prefix
,
2753 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2755 describe_map_tree (start1
, 1, shadow
, prefix
,
2756 "\f\n`local-map' Property Bindings",
2759 shadow
= Fcons (start1
, shadow
);
2763 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2764 "\f\nGlobal Bindings", nomenu
, 0, 1);
2766 /* Print the function-key-map translations under this prefix. */
2767 if (!NILP (Vfunction_key_map
))
2768 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2769 "\f\nFunction key map translations", nomenu
, 1, 0);
2775 /* Insert a description of the key bindings in STARTMAP,
2776 followed by those of all maps reachable through STARTMAP.
2777 If PARTIAL is nonzero, omit certain "uninteresting" commands
2778 (such as `undefined').
2779 If SHADOW is non-nil, it is a list of maps;
2780 don't mention keys which would be shadowed by any of them.
2781 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2782 TITLE, if not 0, is a string to insert at the beginning.
2783 TITLE should not end with a colon or a newline; we supply that.
2784 If NOMENU is not 0, then omit menu-bar commands.
2786 If TRANSL is nonzero, the definitions are actually key translations
2787 so print strings and vectors differently.
2789 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2793 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2795 Lisp_Object startmap
, shadow
, prefix
;
2802 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2803 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2810 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2813 GCPRO3 (maps
, seen
, sub_shadows
);
2819 /* Delete from MAPS each element that is for the menu bar. */
2820 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2822 Lisp_Object elt
, prefix
, tem
;
2825 prefix
= Fcar (elt
);
2826 if (XVECTOR (prefix
)->size
>= 1)
2828 tem
= Faref (prefix
, make_number (0));
2829 if (EQ (tem
, Qmenu_bar
))
2830 maps
= Fdelq (elt
, maps
);
2835 if (!NILP (maps
) || always_title
)
2839 insert_string (title
);
2842 insert_string (" Starting With ");
2843 insert1 (Fkey_description (prefix
));
2845 insert_string (":\n");
2847 insert_string (key_heading
);
2851 for (; !NILP (maps
); maps
= Fcdr (maps
))
2853 register Lisp_Object elt
, prefix
, tail
;
2856 prefix
= Fcar (elt
);
2860 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2864 shmap
= XCAR (tail
);
2866 /* If the sequence by which we reach this keymap is zero-length,
2867 then the shadow map for this keymap is just SHADOW. */
2868 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
2869 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2871 /* If the sequence by which we reach this keymap actually has
2872 some elements, then the sequence's definition in SHADOW is
2873 what we should use. */
2876 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2877 if (INTEGERP (shmap
))
2881 /* If shmap is not nil and not a keymap,
2882 it completely shadows this map, so don't
2883 describe this map at all. */
2884 if (!NILP (shmap
) && !KEYMAPP (shmap
))
2888 sub_shadows
= Fcons (shmap
, sub_shadows
);
2891 /* Maps we have already listed in this loop shadow this map. */
2892 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
2895 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
2897 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
2900 describe_map (Fcdr (elt
), prefix
,
2901 transl
? describe_translation
: describe_command
,
2902 partial
, sub_shadows
, &seen
, nomenu
);
2908 insert_string ("\n");
2913 static int previous_description_column
;
2916 describe_command (definition
, args
)
2917 Lisp_Object definition
, args
;
2919 register Lisp_Object tem1
;
2920 int column
= (int) current_column (); /* iftc */
2921 int description_column
;
2923 /* If column 16 is no good, go to col 32;
2924 but don't push beyond that--go to next line instead. */
2928 description_column
= 32;
2930 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
2931 description_column
= 32;
2933 description_column
= 16;
2935 Findent_to (make_number (description_column
), make_number (1));
2936 previous_description_column
= description_column
;
2938 if (SYMBOLP (definition
))
2940 tem1
= SYMBOL_NAME (definition
);
2942 insert_string ("\n");
2944 else if (STRINGP (definition
) || VECTORP (definition
))
2945 insert_string ("Keyboard Macro\n");
2946 else if (KEYMAPP (definition
))
2947 insert_string ("Prefix Command\n");
2949 insert_string ("??\n");
2953 describe_translation (definition
, args
)
2954 Lisp_Object definition
, args
;
2956 register Lisp_Object tem1
;
2958 Findent_to (make_number (16), make_number (1));
2960 if (SYMBOLP (definition
))
2962 tem1
= SYMBOL_NAME (definition
);
2964 insert_string ("\n");
2966 else if (STRINGP (definition
) || VECTORP (definition
))
2968 insert1 (Fkey_description (definition
));
2969 insert_string ("\n");
2971 else if (KEYMAPP (definition
))
2972 insert_string ("Prefix Command\n");
2974 insert_string ("??\n");
2977 /* Describe the contents of map MAP, assuming that this map itself is
2978 reached by the sequence of prefix keys KEYS (a string or vector).
2979 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2982 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
2983 register Lisp_Object map
;
2985 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
2991 Lisp_Object elt_prefix
;
2992 Lisp_Object tail
, definition
, event
;
2994 Lisp_Object suppress
;
2997 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3001 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
3003 /* Call Fkey_description first, to avoid GC bug for the other string. */
3004 tem
= Fkey_description (keys
);
3005 elt_prefix
= concat2 (tem
, build_string (" "));
3011 suppress
= intern ("suppress-keymap");
3013 /* This vector gets used to present single keys to Flookup_key. Since
3014 that is done once per keymap element, we don't want to cons up a
3015 fresh vector every time. */
3016 kludge
= Fmake_vector (make_number (1), Qnil
);
3019 GCPRO3 (elt_prefix
, definition
, kludge
);
3021 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3025 if (VECTORP (XCAR (tail
))
3026 || CHAR_TABLE_P (XCAR (tail
)))
3027 describe_vector (XCAR (tail
),
3028 elt_prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3030 else if (CONSP (XCAR (tail
)))
3032 event
= XCAR (XCAR (tail
));
3034 /* Ignore bindings whose "keys" are not really valid events.
3035 (We get these in the frames and buffers menu.) */
3036 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3039 if (nomenu
&& EQ (event
, Qmenu_bar
))
3042 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3044 /* Don't show undefined commands or suppressed commands. */
3045 if (NILP (definition
)) continue;
3046 if (SYMBOLP (definition
) && partial
)
3048 tem
= Fget (definition
, suppress
);
3053 /* Don't show a command that isn't really visible
3054 because a local definition of the same key shadows it. */
3056 ASET (kludge
, 0, event
);
3059 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3060 if (!NILP (tem
)) continue;
3063 tem
= Flookup_key (map
, kludge
, Qt
);
3064 if (!EQ (tem
, definition
)) continue;
3068 previous_description_column
= 0;
3073 if (!NILP (elt_prefix
))
3074 insert1 (elt_prefix
);
3076 /* THIS gets the string to describe the character EVENT. */
3077 insert1 (Fsingle_key_description (event
, Qnil
));
3079 /* Print a description of the definition of this character.
3080 elt_describer will take care of spacing out far enough
3081 for alignment purposes. */
3082 (*elt_describer
) (definition
, Qnil
);
3084 else if (EQ (XCAR (tail
), Qkeymap
))
3086 /* The same keymap might be in the structure twice, if we're
3087 using an inherited keymap. So skip anything we've already
3089 tem
= Fassq (tail
, *seen
);
3090 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), keys
)))
3092 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
3100 describe_vector_princ (elt
, fun
)
3101 Lisp_Object elt
, fun
;
3103 Findent_to (make_number (16), make_number (1));
3108 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3109 doc
: /* Insert a description of contents of VECTOR.
3110 This is text showing the elements of vector matched against indices. */)
3112 Lisp_Object vector
, describer
;
3114 int count
= SPECPDL_INDEX ();
3115 if (NILP (describer
))
3116 describer
= intern ("princ");
3117 specbind (Qstandard_output
, Fcurrent_buffer ());
3118 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3119 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3120 Qnil
, Qnil
, (int *)0, 0);
3122 return unbind_to (count
, Qnil
);
3125 /* Insert in the current buffer a description of the contents of VECTOR.
3126 We call ELT_DESCRIBER to insert the description of one value found
3129 ELT_PREFIX describes what "comes before" the keys or indices defined
3130 by this vector. This is a human-readable string whose size
3131 is not necessarily related to the situation.
3133 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3134 leads to this keymap.
3136 If the vector is a chartable, ELT_PREFIX is the vector
3137 of bytes that lead to the character set or portion of a character
3138 set described by this chartable.
3140 If PARTIAL is nonzero, it means do not mention suppressed commands
3141 (that assumes the vector is in a keymap).
3143 SHADOW is a list of keymaps that shadow this map.
3144 If it is non-nil, then we look up the key in those maps
3145 and we don't mention it now if it is defined by any of them.
3147 ENTIRE_MAP is the keymap in which this vector appears.
3148 If the definition in effect in the whole map does not match
3149 the one in this vector, we ignore this one.
3151 When describing a sub-char-table, INDICES is a list of
3152 indices at higher levels in this char-table,
3153 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3155 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3158 describe_vector (vector
, elt_prefix
, args
, elt_describer
,
3159 partial
, shadow
, entire_map
,
3160 indices
, char_table_depth
)
3161 register Lisp_Object vector
;
3162 Lisp_Object elt_prefix
, args
;
3163 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3166 Lisp_Object entire_map
;
3168 int char_table_depth
;
3170 Lisp_Object definition
;
3173 Lisp_Object suppress
;
3176 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3177 /* Range of elements to be handled. */
3179 /* A flag to tell if a leaf in this level of char-table is not a
3180 generic character (i.e. a complete multibyte character). */
3188 indices
= (int *) alloca (3 * sizeof (int));
3192 /* This vector gets used to present single keys to Flookup_key. Since
3193 that is done once per vector element, we don't want to cons up a
3194 fresh vector every time. */
3195 kludge
= Fmake_vector (make_number (1), Qnil
);
3196 GCPRO3 (elt_prefix
, definition
, kludge
);
3199 suppress
= intern ("suppress-keymap");
3201 if (CHAR_TABLE_P (vector
))
3203 if (char_table_depth
== 0)
3205 /* VECTOR is a top level char-table. */
3208 to
= CHAR_TABLE_ORDINARY_SLOTS
;
3212 /* VECTOR is a sub char-table. */
3213 if (char_table_depth
>= 3)
3214 /* A char-table is never that deep. */
3215 error ("Too deep char table");
3218 = (CHARSET_VALID_P (indices
[0])
3219 && ((CHARSET_DIMENSION (indices
[0]) == 1
3220 && char_table_depth
== 1)
3221 || char_table_depth
== 2));
3223 /* Meaningful elements are from 32th to 127th. */
3225 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
3230 /* This does the right thing for ordinary vectors. */
3234 to
= XVECTOR (vector
)->size
;
3237 for (i
= from
; i
< to
; i
++)
3241 if (CHAR_TABLE_P (vector
))
3243 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3246 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3247 && !CHARSET_DEFINED_P (i
- 128))
3251 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3254 definition
= get_keyelt (AREF (vector
, i
), 0);
3256 if (NILP (definition
)) continue;
3258 /* Don't mention suppressed commands. */
3259 if (SYMBOLP (definition
) && partial
)
3263 tem
= Fget (definition
, suppress
);
3265 if (!NILP (tem
)) continue;
3268 /* Set CHARACTER to the character this entry describes, if any.
3269 Also update *INDICES. */
3270 if (CHAR_TABLE_P (vector
))
3272 indices
[char_table_depth
] = i
;
3274 if (char_table_depth
== 0)
3277 indices
[0] = i
- 128;
3279 else if (complete_char
)
3281 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3289 /* If this binding is shadowed by some other map, ignore it. */
3290 if (!NILP (shadow
) && complete_char
)
3294 ASET (kludge
, 0, make_number (character
));
3295 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3297 if (!NILP (tem
)) continue;
3300 /* Ignore this definition if it is shadowed by an earlier
3301 one in the same keymap. */
3302 if (!NILP (entire_map
) && complete_char
)
3306 ASET (kludge
, 0, make_number (character
));
3307 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3309 if (!EQ (tem
, definition
))
3315 if (char_table_depth
== 0)
3320 /* For a sub char-table, show the depth by indentation.
3321 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3322 if (char_table_depth
> 0)
3323 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3325 /* Output the prefix that applies to every entry in this map. */
3326 if (!NILP (elt_prefix
))
3327 insert1 (elt_prefix
);
3329 /* Insert or describe the character this slot is for,
3330 or a description of what it is for. */
3331 if (SUB_CHAR_TABLE_P (vector
))
3334 insert_char (character
);
3337 /* We need an octal representation for this block of
3340 sprintf (work
, "(row %d)", i
);
3341 insert (work
, strlen (work
));
3344 else if (CHAR_TABLE_P (vector
))
3347 insert1 (Fsingle_key_description (make_number (character
), Qnil
));
3350 /* Print the information for this character set. */
3351 insert_string ("<");
3352 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3354 insert_from_string (tem2
, 0, 0, SCHARS (tem2
),
3363 insert1 (Fsingle_key_description (make_number (character
), Qnil
));
3366 /* If we find a sub char-table within a char-table,
3367 scan it recursively; it defines the details for
3368 a character set or a portion of a character set. */
3369 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3372 describe_vector (definition
, elt_prefix
, args
, elt_describer
,
3373 partial
, shadow
, entire_map
,
3374 indices
, char_table_depth
+ 1);
3380 /* Find all consecutive characters or rows that have the same
3381 definition. But, for elements of a top level char table, if
3382 they are for charsets, we had better describe one by one even
3383 if they have the same definition. */
3384 if (CHAR_TABLE_P (vector
))
3388 if (char_table_depth
== 0)
3389 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3391 while (i
+ 1 < limit
3392 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3394 && !NILP (Fequal (tem2
, definition
)))
3399 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3401 && !NILP (Fequal (tem2
, definition
)))
3405 /* If we have a range of more than one character,
3406 print where the range reaches to. */
3408 if (i
!= starting_i
)
3412 if (!NILP (elt_prefix
))
3413 insert1 (elt_prefix
);
3415 if (CHAR_TABLE_P (vector
))
3417 if (char_table_depth
== 0)
3419 insert1 (Fsingle_key_description (make_number (i
), Qnil
));
3421 else if (complete_char
)
3423 indices
[char_table_depth
] = i
;
3424 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3425 insert_char (character
);
3429 /* We need an octal representation for this block of
3432 sprintf (work
, "(row %d)", i
);
3433 insert (work
, strlen (work
));
3438 insert1 (Fsingle_key_description (make_number (i
), Qnil
));
3442 /* Print a description of the definition of this character.
3443 elt_describer will take care of spacing out far enough
3444 for alignment purposes. */
3445 (*elt_describer
) (definition
, args
);
3448 /* For (sub) char-table, print `defalt' slot at last. */
3449 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3451 insert (" ", char_table_depth
* 2);
3452 insert_string ("<<default>>");
3453 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3459 /* Apropos - finding all symbols whose names match a regexp. */
3460 static Lisp_Object apropos_predicate
;
3461 static Lisp_Object apropos_accumulate
;
3464 apropos_accum (symbol
, string
)
3465 Lisp_Object symbol
, string
;
3467 register Lisp_Object tem
;
3469 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3470 if (!NILP (tem
) && !NILP (apropos_predicate
))
3471 tem
= call1 (apropos_predicate
, symbol
);
3473 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3476 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3477 doc
: /* Show all symbols whose names contain match for REGEXP.
3478 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3479 for each symbol and a symbol is mentioned only if that returns non-nil.
3480 Return list of symbols found. */)
3482 Lisp_Object regexp
, predicate
;
3485 CHECK_STRING (regexp
);
3486 apropos_predicate
= predicate
;
3487 apropos_accumulate
= Qnil
;
3488 map_obarray (Vobarray
, apropos_accum
, regexp
);
3489 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3490 apropos_accumulate
= Qnil
;
3491 apropos_predicate
= Qnil
;
3498 Qkeymap
= intern ("keymap");
3499 staticpro (&Qkeymap
);
3500 staticpro (&apropos_predicate
);
3501 staticpro (&apropos_accumulate
);
3502 apropos_predicate
= Qnil
;
3503 apropos_accumulate
= Qnil
;
3505 /* Now we are ready to set up this property, so we can
3506 create char tables. */
3507 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3509 /* Initialize the keymaps standardly used.
3510 Each one is the value of a Lisp variable, and is also
3511 pointed to by a C variable */
3513 global_map
= Fmake_keymap (Qnil
);
3514 Fset (intern ("global-map"), global_map
);
3516 current_global_map
= global_map
;
3517 staticpro (&global_map
);
3518 staticpro (¤t_global_map
);
3520 meta_map
= Fmake_keymap (Qnil
);
3521 Fset (intern ("esc-map"), meta_map
);
3522 Ffset (intern ("ESC-prefix"), meta_map
);
3524 control_x_map
= Fmake_keymap (Qnil
);
3525 Fset (intern ("ctl-x-map"), control_x_map
);
3526 Ffset (intern ("Control-X-prefix"), control_x_map
);
3529 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3530 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3531 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3532 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3533 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3535 staticpro (&exclude_keys
);
3537 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3538 doc
: /* List of commands given new key bindings recently.
3539 This is used for internal purposes during Emacs startup;
3540 don't alter it yourself. */);
3541 Vdefine_key_rebound_commands
= Qt
;
3543 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3544 doc
: /* Default keymap to use when reading from the minibuffer. */);
3545 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3547 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3548 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3549 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3550 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3552 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3553 doc
: /* Local keymap for minibuffer input with completion. */);
3554 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3555 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3557 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3558 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3559 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3560 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3561 Vminibuffer_local_completion_map
);
3563 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3564 doc
: /* Alist of keymaps to use for minor modes.
3565 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3566 key sequences and look up bindings iff VARIABLE's value is non-nil.
3567 If two active keymaps bind the same key, the keymap appearing earlier
3568 in the list takes precedence. */);
3569 Vminor_mode_map_alist
= Qnil
;
3571 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3572 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3573 This variable is an alist just like `minor-mode-map-alist', and it is
3574 used the same way (and before `minor-mode-map-alist'); however,
3575 it is provided for major modes to bind locally. */);
3576 Vminor_mode_overriding_map_alist
= Qnil
;
3578 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3579 doc
: /* List of keymap alists to use for emulations modes.
3580 It is intended for modes or packages using multiple minor-mode keymaps.
3581 Each element is a keymap alist just like `minor-mode-map-alist', or a
3582 symbol with a variable binding which is a keymap alist, and it is used
3583 the same way. The "active" keymaps in each alist are used before
3584 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3585 Vemulation_mode_map_alists
= Qnil
;
3588 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3589 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3590 This allows Emacs to recognize function keys sent from ASCII
3591 terminals at any point in a key sequence.
3593 The `read-key-sequence' function replaces any subsequence bound by
3594 `function-key-map' with its binding. More precisely, when the active
3595 keymaps have no binding for the current key sequence but
3596 `function-key-map' binds a suffix of the sequence to a vector or string,
3597 `read-key-sequence' replaces the matching suffix with its binding, and
3598 continues with the new sequence.
3600 The events that come from bindings in `function-key-map' are not
3601 themselves looked up in `function-key-map'.
3603 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3604 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3605 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3606 key, typing `ESC O P x' would return [f1 x]. */);
3607 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3609 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3610 doc
: /* Keymap of key translations that can override keymaps.
3611 This keymap works like `function-key-map', but comes after that,
3612 and applies even for keys that have ordinary bindings. */);
3613 Vkey_translation_map
= Qnil
;
3615 staticpro (&Vmenu_events
);
3616 Vmenu_events
= Fcons (intern ("menu-bar"),
3617 Fcons (intern ("tool-bar"),
3618 Fcons (intern ("mouse-1"),
3619 Fcons (intern ("mouse-2"),
3620 Fcons (intern ("mouse-3"),
3624 Qsingle_key_description
= intern ("single-key-description");
3625 staticpro (&Qsingle_key_description
);
3627 Qkey_description
= intern ("key-description");
3628 staticpro (&Qkey_description
);
3630 Qkeymapp
= intern ("keymapp");
3631 staticpro (&Qkeymapp
);
3633 Qnon_ascii
= intern ("non-ascii");
3634 staticpro (&Qnon_ascii
);
3636 Qmenu_item
= intern ("menu-item");
3637 staticpro (&Qmenu_item
);
3639 Qremap
= intern ("remap");
3640 staticpro (&Qremap
);
3642 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3643 staticpro (&command_remapping_vector
);
3645 where_is_cache_keymaps
= Qt
;
3646 where_is_cache
= Qnil
;
3647 staticpro (&where_is_cache
);
3648 staticpro (&where_is_cache_keymaps
);
3650 defsubr (&Skeymapp
);
3651 defsubr (&Skeymap_parent
);
3652 defsubr (&Skeymap_prompt
);
3653 defsubr (&Sset_keymap_parent
);
3654 defsubr (&Smake_keymap
);
3655 defsubr (&Smake_sparse_keymap
);
3656 defsubr (&Scopy_keymap
);
3657 defsubr (&Scommand_remapping
);
3658 defsubr (&Skey_binding
);
3659 defsubr (&Slocal_key_binding
);
3660 defsubr (&Sglobal_key_binding
);
3661 defsubr (&Sminor_mode_key_binding
);
3662 defsubr (&Sdefine_key
);
3663 defsubr (&Slookup_key
);
3664 defsubr (&Sdefine_prefix_command
);
3665 defsubr (&Suse_global_map
);
3666 defsubr (&Suse_local_map
);
3667 defsubr (&Scurrent_local_map
);
3668 defsubr (&Scurrent_global_map
);
3669 defsubr (&Scurrent_minor_mode_maps
);
3670 defsubr (&Scurrent_active_maps
);
3671 defsubr (&Saccessible_keymaps
);
3672 defsubr (&Skey_description
);
3673 defsubr (&Sdescribe_vector
);
3674 defsubr (&Ssingle_key_description
);
3675 defsubr (&Stext_char_description
);
3676 defsubr (&Swhere_is_internal
);
3677 defsubr (&Sdescribe_buffer_bindings
);
3678 defsubr (&Sapropos_internal
);
3684 initial_define_key (global_map
, 033, "ESC-prefix");
3685 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");