1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
33 #include "termhooks.h"
34 #include "blockinput.h"
37 #define min(a, b) ((a) < (b) ? (a) : (b))
39 /* The number of elements in keymap vectors. */
40 #define DENSE_TABLE_SIZE (0200)
42 /* Actually allocate storage for these variables */
44 Lisp_Object current_global_map
; /* Current global keymap */
46 Lisp_Object global_map
; /* default global key bindings */
48 Lisp_Object meta_map
; /* The keymap used for globally bound
49 ESC-prefixed default commands */
51 Lisp_Object control_x_map
; /* The keymap used for globally bound
52 C-x-prefixed default commands */
54 /* was MinibufLocalMap */
55 Lisp_Object Vminibuffer_local_map
;
56 /* The keymap used by the minibuf for local
57 bindings when spaces are allowed in the
60 /* was MinibufLocalNSMap */
61 Lisp_Object Vminibuffer_local_ns_map
;
62 /* The keymap used by the minibuf for local
63 bindings when spaces are not encouraged
66 /* keymap used for minibuffers when doing completion */
67 /* was MinibufLocalCompletionMap */
68 Lisp_Object Vminibuffer_local_completion_map
;
70 /* keymap used for minibuffers when doing completion and require a match */
71 /* was MinibufLocalMustMatchMap */
72 Lisp_Object Vminibuffer_local_must_match_map
;
74 /* Alist of minor mode variables and keymaps. */
75 Lisp_Object Vminor_mode_map_alist
;
77 /* Alist of major-mode-specific overrides for
78 minor mode variables and keymaps. */
79 Lisp_Object Vminor_mode_overriding_map_alist
;
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
;
97 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
98 in a string key sequence is equivalent to prefixing with this
100 extern Lisp_Object meta_prefix_char
;
102 extern Lisp_Object Voverriding_local_map
;
104 static Lisp_Object
define_as_prefix ();
105 static Lisp_Object
describe_buffer_bindings ();
106 static void describe_command (), describe_translation ();
107 static void describe_map ();
109 /* Keymap object support - constructors and predicates. */
111 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
112 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
113 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
114 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
115 mouse events, and any other things that appear in the input stream.\n\
116 All entries in it are initially nil, meaning \"command undefined\".\n\n\
117 The optional arg STRING supplies a menu name for the keymap\n\
118 in case you use it as a menu with `x-popup-menu'.")
124 tail
= Fcons (string
, Qnil
);
127 return Fcons (Qkeymap
,
128 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
131 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
132 "Construct and return a new sparse-keymap list.\n\
133 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
134 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
135 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
136 Initially the alist is nil.\n\n\
137 The optional arg STRING supplies a menu name for the keymap\n\
138 in case you use it as a menu with `x-popup-menu'.")
143 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
144 return Fcons (Qkeymap
, Qnil
);
147 /* This function is used for installing the standard key bindings
148 at initialization time.
152 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
155 initial_define_key (keymap
, key
, defname
)
160 store_in_keymap (keymap
, make_number (key
), intern (defname
));
164 initial_define_lispy_key (keymap
, keyname
, defname
)
169 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
172 /* Define character fromchar in map frommap as an alias for character
173 tochar in map tomap. Subsequent redefinitions of the latter WILL
174 affect the former. */
178 synkey (frommap
, fromchar
, tomap
, tochar
)
179 struct Lisp_Vector
*frommap
, *tomap
;
180 int fromchar
, tochar
;
183 XSETVECTOR (v
, tomap
);
184 XSETFASTINT (c
, tochar
);
185 frommap
->contents
[fromchar
] = Fcons (v
, c
);
189 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
190 "Return t if OBJECT is a keymap.\n\
192 A keymap is a list (keymap . ALIST),\n\
193 or a symbol whose function definition is itself a keymap.\n\
194 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
195 a vector of densely packed bindings for small character codes\n\
196 is also allowed as an element.")
200 return (NILP (get_keymap_1 (object
, 0, 0)) ? Qnil
: Qt
);
203 /* Check that OBJECT is a keymap (after dereferencing through any
204 symbols). If it is, return it.
206 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
207 is an autoload form, do the autoload and try again.
208 If AUTOLOAD is nonzero, callers must assume GC is possible.
210 ERROR controls how we respond if OBJECT isn't a keymap.
211 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
213 Note that most of the time, we don't want to pursue autoloads.
214 Functions like Faccessible_keymaps which scan entire keymap trees
215 shouldn't load every autoloaded keymap. I'm not sure about this,
216 but it seems to me that only read_key_sequence, Flookup_key, and
217 Fdefine_key should cause keymaps to be autoloaded. */
220 get_keymap_1 (object
, error
, autoload
)
229 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
233 tem
= indirect_function (object
);
234 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
238 /* Should we do an autoload? Autoload forms for keymaps have
239 Qkeymap as their fifth element. */
243 && EQ (XCAR (tem
), Qautoload
))
247 tail
= Fnth (make_number (4), tem
);
248 if (EQ (tail
, Qkeymap
))
250 struct gcpro gcpro1
, gcpro2
;
252 GCPRO2 (tem
, object
);
253 do_autoload (tem
, object
);
262 wrong_type_argument (Qkeymapp
, object
);
268 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
269 If OBJECT doesn't denote a keymap at all, signal an error. */
274 return get_keymap_1 (object
, 1, 0);
277 /* Return the parent map of the keymap MAP, or nil if it has none.
278 We assume that MAP is a valid keymap. */
280 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
281 "Return the parent keymap of KEYMAP.")
287 keymap
= get_keymap_1 (keymap
, 1, 1);
289 /* Skip past the initial element `keymap'. */
290 list
= XCDR (keymap
);
291 for (; CONSP (list
); list
= XCDR (list
))
293 /* See if there is another `keymap'. */
294 if (EQ (Qkeymap
, XCAR (list
)))
301 /* Set the parent keymap of MAP to PARENT. */
303 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
304 "Modify KEYMAP to set its parent map to PARENT.\n\
305 PARENT should be nil or another keymap.")
307 Lisp_Object keymap
, parent
;
309 Lisp_Object list
, prev
;
312 keymap
= get_keymap_1 (keymap
, 1, 1);
314 parent
= get_keymap_1 (parent
, 1, 1);
316 /* Skip past the initial element `keymap'. */
321 /* If there is a parent keymap here, replace it.
322 If we came to the end, add the parent in PREV. */
323 if (! CONSP (list
) || EQ (Qkeymap
, XCAR (list
)))
325 /* If we already have the right parent, return now
326 so that we avoid the loops below. */
327 if (EQ (XCDR (prev
), parent
))
330 XCDR (prev
) = parent
;
336 /* Scan through for submaps, and set their parents too. */
338 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
340 /* Stop the scan when we come to the parent. */
341 if (EQ (XCAR (list
), Qkeymap
))
344 /* If this element holds a prefix map, deal with it. */
345 if (CONSP (XCAR (list
))
346 && CONSP (XCDR (XCAR (list
))))
347 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
350 if (VECTORP (XCAR (list
)))
351 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
352 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
353 fix_submap_inheritance (keymap
, make_number (i
),
354 XVECTOR (XCAR (list
))->contents
[i
]);
356 if (CHAR_TABLE_P (XCAR (list
)))
358 Lisp_Object indices
[3];
360 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
),
368 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
369 if EVENT is also a prefix in MAP's parent,
370 make sure that SUBMAP inherits that definition as its own parent. */
373 fix_submap_inheritance (map
, event
, submap
)
374 Lisp_Object map
, event
, submap
;
376 Lisp_Object map_parent
, parent_entry
;
378 /* SUBMAP is a cons that we found as a key binding.
379 Discard the other things found in a menu key binding. */
383 /* May be an old format menu item */
384 if (STRINGP (XCAR (submap
)))
386 submap
= XCDR (submap
);
387 /* Also remove a menu help string, if any,
388 following the menu item name. */
389 if (CONSP (submap
) && STRINGP (XCAR (submap
)))
390 submap
= XCDR (submap
);
391 /* Also remove the sublist that caches key equivalences, if any. */
393 && CONSP (XCAR (submap
)))
396 carcar
= XCAR (XCAR (submap
));
397 if (NILP (carcar
) || VECTORP (carcar
))
398 submap
= XCDR (submap
);
402 /* Or a new format menu item */
403 else if (EQ (XCAR (submap
), Qmenu_item
)
404 && CONSP (XCDR (submap
)))
406 submap
= XCDR (XCDR (submap
));
408 submap
= XCAR (submap
);
412 /* If it isn't a keymap now, there's no work to do. */
414 || ! EQ (XCAR (submap
), Qkeymap
))
417 map_parent
= Fkeymap_parent (map
);
418 if (! NILP (map_parent
))
419 parent_entry
= access_keymap (map_parent
, event
, 0, 0);
423 /* If MAP's parent has something other than a keymap,
424 our own submap shadows it completely, so use nil as SUBMAP's parent. */
425 if (! (CONSP (parent_entry
) && EQ (XCAR (parent_entry
), Qkeymap
)))
428 if (! EQ (parent_entry
, submap
))
430 Lisp_Object submap_parent
;
431 submap_parent
= submap
;
435 tem
= Fkeymap_parent (submap_parent
);
436 if (EQ (tem
, parent_entry
))
439 && EQ (XCAR (tem
), Qkeymap
))
444 Fset_keymap_parent (submap_parent
, parent_entry
);
448 /* Look up IDX in MAP. IDX may be any sort of event.
449 Note that this does only one level of lookup; IDX must be a single
450 event, not a sequence.
452 If T_OK is non-zero, bindings for Qt are treated as default
453 bindings; any key left unmentioned by other tables and bindings is
454 given the binding of Qt.
456 If T_OK is zero, bindings for Qt are not treated specially.
458 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
461 access_keymap (map
, idx
, t_ok
, noinherit
)
470 /* If idx is a list (some sort of mouse click, perhaps?),
471 the index we want to use is the car of the list, which
472 ought to be a symbol. */
473 idx
= EVENT_HEAD (idx
);
475 /* If idx is a symbol, it might have modifiers, which need to
476 be put in the canonical order. */
478 idx
= reorder_modifiers (idx
);
479 else if (INTEGERP (idx
))
480 /* Clobber the high bits that can be present on a machine
481 with more than 24 bits of integer. */
482 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
486 Lisp_Object t_binding
;
489 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
493 binding
= XCAR (tail
);
494 if (SYMBOLP (binding
))
496 /* If NOINHERIT, stop finding prefix definitions
497 after we pass a second occurrence of the `keymap' symbol. */
498 if (noinherit
&& EQ (binding
, Qkeymap
) && ! EQ (tail
, map
))
501 else if (CONSP (binding
))
503 if (EQ (XCAR (binding
), idx
))
505 val
= XCDR (binding
);
506 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
509 fix_submap_inheritance (map
, idx
, val
);
512 if (t_ok
&& EQ (XCAR (binding
), Qt
))
513 t_binding
= XCDR (binding
);
515 else if (VECTORP (binding
))
517 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (binding
)->size
)
519 val
= XVECTOR (binding
)->contents
[XFASTINT (idx
)];
520 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
523 fix_submap_inheritance (map
, idx
, val
);
527 else if (CHAR_TABLE_P (binding
))
529 /* Character codes with modifiers
530 are not included in a char-table.
531 All character codes without modifiers are included. */
534 & (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
535 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
)))
537 val
= Faref (binding
, idx
);
538 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
541 fix_submap_inheritance (map
, idx
, val
);
553 /* Given OBJECT which was found in a slot in a keymap,
554 trace indirect definitions to get the actual definition of that slot.
555 An indirect definition is a list of the form
556 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
557 and INDEX is the object to look up in KEYMAP to yield the definition.
559 Also if OBJECT has a menu string as the first element,
560 remove that. Also remove a menu help string as second element.
562 If AUTOLOAD is nonzero, load autoloadable keymaps
563 that are referred to with indirection. */
566 get_keyelt (object
, autoload
)
567 register Lisp_Object object
;
572 if (!(CONSP (object
)))
573 /* This is really the value. */
576 /* If the keymap contents looks like (keymap ...) or (lambda ...)
578 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
581 /* If the keymap contents looks like (menu-item name . DEFN)
582 or (menu-item name DEFN ...) then use DEFN.
583 This is a new format menu item.
585 else if (EQ (XCAR (object
), Qmenu_item
))
587 if (CONSP (XCDR (object
)))
589 object
= XCDR (XCDR (object
));
591 object
= XCAR (object
);
598 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
599 Keymap alist elements like (CHAR MENUSTRING . DEFN)
600 will be used by HierarKey menus. */
601 else if (STRINGP (XCAR (object
)))
603 object
= XCDR (object
);
604 /* Also remove a menu help string, if any,
605 following the menu item name. */
606 if (CONSP (object
) && STRINGP (XCAR (object
)))
607 object
= XCDR (object
);
608 /* Also remove the sublist that caches key equivalences, if any. */
609 if (CONSP (object
) && CONSP (XCAR (object
)))
612 carcar
= XCAR (XCAR (object
));
613 if (NILP (carcar
) || VECTORP (carcar
))
614 object
= XCDR (object
);
618 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
621 register Lisp_Object map
;
622 map
= get_keymap_1 (Fcar_safe (object
), 0, autoload
);
630 if (INTEGERP (key
) && (XINT (key
) & meta_modifier
))
632 object
= access_keymap (map
, meta_prefix_char
, 0, 0);
633 map
= get_keymap_1 (object
, 0, autoload
);
634 object
= access_keymap (map
, make_number (XINT (key
)
639 object
= access_keymap (map
, key
, 0, 0);
646 store_in_keymap (keymap
, idx
, def
)
648 register Lisp_Object idx
;
649 register Lisp_Object def
;
651 /* If we are preparing to dump, and DEF is a menu element
652 with a menu item indicator, copy it to ensure it is not pure. */
653 if (CONSP (def
) && PURE_P (def
)
654 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
655 def
= Fcons (XCAR (def
), XCDR (def
));
657 if (!CONSP (keymap
) || ! EQ (XCAR (keymap
), Qkeymap
))
658 error ("attempt to define a key in a non-keymap");
660 /* If idx is a list (some sort of mouse click, perhaps?),
661 the index we want to use is the car of the list, which
662 ought to be a symbol. */
663 idx
= EVENT_HEAD (idx
);
665 /* If idx is a symbol, it might have modifiers, which need to
666 be put in the canonical order. */
668 idx
= reorder_modifiers (idx
);
669 else if (INTEGERP (idx
))
670 /* Clobber the high bits that can be present on a machine
671 with more than 24 bits of integer. */
672 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
674 /* Scan the keymap for a binding of idx. */
678 /* The cons after which we should insert new bindings. If the
679 keymap has a table element, we record its position here, so new
680 bindings will go after it; this way, the table will stay
681 towards the front of the alist and character lookups in dense
682 keymaps will remain fast. Otherwise, this just points at the
683 front of the keymap. */
684 Lisp_Object insertion_point
;
686 insertion_point
= keymap
;
687 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
694 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (elt
)->size
)
696 XVECTOR (elt
)->contents
[XFASTINT (idx
)] = def
;
699 insertion_point
= tail
;
701 else if (CHAR_TABLE_P (elt
))
703 /* Character codes with modifiers
704 are not included in a char-table.
705 All character codes without modifiers are included. */
708 & (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
709 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
)))
711 Faset (elt
, idx
, def
);
714 insertion_point
= tail
;
716 else if (CONSP (elt
))
718 if (EQ (idx
, XCAR (elt
)))
724 else if (SYMBOLP (elt
))
726 /* If we find a 'keymap' symbol in the spine of KEYMAP,
727 then we must have found the start of a second keymap
728 being used as the tail of KEYMAP, and a binding for IDX
729 should be inserted before it. */
730 if (EQ (elt
, Qkeymap
))
738 /* We have scanned the entire keymap, and not found a binding for
739 IDX. Let's add one. */
740 XCDR (insertion_point
)
741 = Fcons (Fcons (idx
, def
), XCDR (insertion_point
));
748 copy_keymap_1 (chartable
, idx
, elt
)
749 Lisp_Object chartable
, idx
, elt
;
751 if (!SYMBOLP (elt
) && ! NILP (Fkeymapp (elt
)))
752 Faset (chartable
, idx
, Fcopy_keymap (elt
));
755 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
756 "Return a copy of the keymap KEYMAP.\n\
757 The copy starts out with the same definitions of KEYMAP,\n\
758 but changing either the copy or KEYMAP does not affect the other.\n\
759 Any key definitions that are subkeymaps are recursively copied.\n\
760 However, a key definition which is a symbol whose definition is a keymap\n\
765 register Lisp_Object copy
, tail
;
767 copy
= Fcopy_alist (get_keymap (keymap
));
769 for (tail
= copy
; CONSP (tail
); tail
= XCDR (tail
))
774 if (CHAR_TABLE_P (elt
))
776 Lisp_Object indices
[3];
778 elt
= Fcopy_sequence (elt
);
781 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, 0, indices
);
783 else if (VECTORP (elt
))
787 elt
= Fcopy_sequence (elt
);
790 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
791 if (!SYMBOLP (XVECTOR (elt
)->contents
[i
])
792 && ! NILP (Fkeymapp (XVECTOR (elt
)->contents
[i
])))
793 XVECTOR (elt
)->contents
[i
]
794 = Fcopy_keymap (XVECTOR (elt
)->contents
[i
]);
796 else if (CONSP (elt
) && CONSP (XCDR (elt
)))
801 /* Is this a new format menu item. */
802 if (EQ (XCAR (tem
),Qmenu_item
))
804 /* Copy cell with menu-item marker. */
806 = Fcons (XCAR (tem
), XCDR (tem
));
811 /* Copy cell with menu-item name. */
813 = Fcons (XCAR (tem
), XCDR (tem
));
819 /* Copy cell with binding and if the binding is a keymap,
822 = Fcons (XCAR (tem
), XCDR (tem
));
825 if (!(SYMBOLP (tem
) || NILP (Fkeymapp (tem
))))
826 XCAR (elt
) = Fcopy_keymap (tem
);
828 if (CONSP (tem
) && CONSP (XCAR (tem
)))
829 /* Delete cache for key equivalences. */
830 XCDR (elt
) = XCDR (tem
);
835 /* It may be an old fomat menu item.
836 Skip the optional menu string.
838 if (STRINGP (XCAR (tem
)))
840 /* Copy the cell, since copy-alist didn't go this deep. */
842 = Fcons (XCAR (tem
), XCDR (tem
));
845 /* Also skip the optional menu help string. */
846 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
849 = Fcons (XCAR (tem
), XCDR (tem
));
853 /* There may also be a list that caches key equivalences.
854 Just delete it for the new keymap. */
856 && CONSP (XCAR (tem
))
857 && (NILP (XCAR (XCAR (tem
)))
858 || VECTORP (XCAR (XCAR (tem
)))))
859 XCDR (elt
) = XCDR (tem
);
862 && ! SYMBOLP (XCDR (elt
))
863 && ! NILP (Fkeymapp (XCDR (elt
))))
864 XCDR (elt
) = Fcopy_keymap (XCDR (elt
));
873 /* Simple Keymap mutators and accessors. */
875 /* GC is possible in this function if it autoloads a keymap. */
877 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
878 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
879 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
880 meaning a sequence of keystrokes and events.\n\
881 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
882 can be included if you use a vector.\n\
883 DEF is anything that can be a key's definition:\n\
884 nil (means key is undefined in this keymap),\n\
885 a command (a Lisp function suitable for interactive calling)\n\
886 a string (treated as a keyboard macro),\n\
887 a keymap (to define a prefix key),\n\
888 a symbol. When the key is looked up, the symbol will stand for its\n\
889 function definition, which should at that time be one of the above,\n\
890 or another symbol whose function definition is used, etc.\n\
891 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
892 (DEFN should be a valid definition in its own right),\n\
893 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
895 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
896 the front of KEYMAP.")
903 register Lisp_Object c
;
904 register Lisp_Object cmd
;
908 struct gcpro gcpro1
, gcpro2
, gcpro3
;
910 keymap
= get_keymap_1 (keymap
, 1, 1);
912 if (!VECTORP (key
) && !STRINGP (key
))
913 key
= wrong_type_argument (Qarrayp
, key
);
915 length
= XFASTINT (Flength (key
));
919 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
920 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
922 GCPRO3 (keymap
, key
, def
);
925 meta_bit
= meta_modifier
;
932 c
= Faref (key
, make_number (idx
));
934 if (CONSP (c
) && lucid_event_type_list_p (c
))
935 c
= Fevent_convert_list (c
);
938 && (XINT (c
) & meta_bit
)
941 c
= meta_prefix_char
;
947 XSETINT (c
, XINT (c
) & ~meta_bit
);
953 if (! INTEGERP (c
) && ! SYMBOLP (c
) && ! CONSP (c
))
954 error ("Key sequence contains invalid events");
957 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
959 cmd
= get_keyelt (access_keymap (keymap
, c
, 0, 1), 1);
961 /* If this key is undefined, make it a prefix. */
963 cmd
= define_as_prefix (keymap
, c
);
965 keymap
= get_keymap_1 (cmd
, 0, 1);
967 /* We must use Fkey_description rather than just passing key to
968 error; key might be a vector, not a string. */
969 error ("Key sequence %s uses invalid prefix characters",
970 XSTRING (Fkey_description (key
))->data
);
974 /* Value is number if KEY is too long; NIL if valid but has no definition. */
975 /* GC is possible in this function if it autoloads a keymap. */
977 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
978 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
979 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
981 A number as value means KEY is \"too long\";\n\
982 that is, characters or symbols in it except for the last one\n\
983 fail to be a valid sequence of prefix characters in KEYMAP.\n\
984 The number is how many characters at the front of KEY\n\
985 it takes to reach a non-prefix command.\n\
987 Normally, `lookup-key' ignores bindings for t, which act as default\n\
988 bindings, used when nothing else in the keymap applies; this makes it\n\
989 usable as a general function for probing keymaps. However, if the\n\
990 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
991 recognize the default bindings, just as `read-key-sequence' does.")
992 (keymap
, key
, accept_default
)
993 register Lisp_Object keymap
;
995 Lisp_Object accept_default
;
998 register Lisp_Object cmd
;
999 register Lisp_Object c
;
1002 int t_ok
= ! NILP (accept_default
);
1004 struct gcpro gcpro1
;
1006 keymap
= get_keymap_1 (keymap
, 1, 1);
1008 if (!VECTORP (key
) && !STRINGP (key
))
1009 key
= wrong_type_argument (Qarrayp
, key
);
1011 length
= XFASTINT (Flength (key
));
1016 meta_bit
= meta_modifier
;
1025 c
= Faref (key
, make_number (idx
));
1027 if (CONSP (c
) && lucid_event_type_list_p (c
))
1028 c
= Fevent_convert_list (c
);
1031 && (XINT (c
) & meta_bit
)
1034 c
= meta_prefix_char
;
1040 XSETINT (c
, XINT (c
) & ~meta_bit
);
1046 cmd
= get_keyelt (access_keymap (keymap
, c
, t_ok
, 0), 1);
1048 RETURN_UNGCPRO (cmd
);
1050 keymap
= get_keymap_1 (cmd
, 0, 1);
1052 RETURN_UNGCPRO (make_number (idx
));
1058 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1059 Assume that currently it does not define C at all.
1060 Return the keymap. */
1063 define_as_prefix (keymap
, c
)
1064 Lisp_Object keymap
, c
;
1066 Lisp_Object inherit
, cmd
;
1068 cmd
= Fmake_sparse_keymap (Qnil
);
1069 /* If this key is defined as a prefix in an inherited keymap,
1070 make it a prefix in this map, and make its definition
1071 inherit the other prefix definition. */
1072 inherit
= access_keymap (keymap
, c
, 0, 0);
1074 /* This code is needed to do the right thing in the following case:
1075 keymap A inherits from B,
1076 you define KEY as a prefix in A,
1077 then later you define KEY as a prefix in B.
1078 We want the old prefix definition in A to inherit from that in B.
1079 It is hard to do that retroactively, so this code
1080 creates the prefix in B right away.
1082 But it turns out that this code causes problems immediately
1083 when the prefix in A is defined: it causes B to define KEY
1084 as a prefix with no subcommands.
1086 So I took out this code. */
1089 /* If there's an inherited keymap
1090 and it doesn't define this key,
1091 make it define this key. */
1094 for (tail
= Fcdr (keymap
); CONSP (tail
); tail
= XCDR (tail
))
1095 if (EQ (XCAR (tail
), Qkeymap
))
1099 inherit
= define_as_prefix (tail
, c
);
1103 cmd
= nconc2 (cmd
, inherit
);
1104 store_in_keymap (keymap
, c
, cmd
);
1109 /* Append a key to the end of a key sequence. We always make a vector. */
1112 append_key (key_sequence
, key
)
1113 Lisp_Object key_sequence
, key
;
1115 Lisp_Object args
[2];
1117 args
[0] = key_sequence
;
1119 args
[1] = Fcons (key
, Qnil
);
1120 return Fvconcat (2, args
);
1124 /* Global, local, and minor mode keymap stuff. */
1126 /* We can't put these variables inside current_minor_maps, since under
1127 some systems, static gets macro-defined to be the empty string.
1129 static Lisp_Object
*cmm_modes
, *cmm_maps
;
1130 static int cmm_size
;
1132 /* Error handler used in current_minor_maps. */
1134 current_minor_maps_error ()
1139 /* Store a pointer to an array of the keymaps of the currently active
1140 minor modes in *buf, and return the number of maps it contains.
1142 This function always returns a pointer to the same buffer, and may
1143 free or reallocate it, so if you want to keep it for a long time or
1144 hand it out to lisp code, copy it. This procedure will be called
1145 for every key sequence read, so the nice lispy approach (return a
1146 new assoclist, list, what have you) for each invocation would
1147 result in a lot of consing over time.
1149 If we used xrealloc/xmalloc and ran out of memory, they would throw
1150 back to the command loop, which would try to read a key sequence,
1151 which would call this function again, resulting in an infinite
1152 loop. Instead, we'll use realloc/malloc and silently truncate the
1153 list, let the key sequence be read, and hope some other piece of
1154 code signals the error. */
1156 current_minor_maps (modeptr
, mapptr
)
1157 Lisp_Object
**modeptr
, **mapptr
;
1160 int list_number
= 0;
1161 Lisp_Object alist
, assoc
, var
, val
;
1162 Lisp_Object lists
[2];
1164 lists
[0] = Vminor_mode_overriding_map_alist
;
1165 lists
[1] = Vminor_mode_map_alist
;
1167 for (list_number
= 0; list_number
< 2; list_number
++)
1168 for (alist
= lists
[list_number
];
1170 alist
= XCDR (alist
))
1171 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1172 && (var
= XCAR (assoc
), SYMBOLP (var
))
1173 && (val
= find_symbol_value (var
), ! EQ (val
, Qunbound
))
1178 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1179 and also an entry in Vminor_mode_map_alist,
1180 ignore the latter. */
1181 if (list_number
== 1)
1183 val
= assq_no_quit (var
, lists
[0]);
1190 Lisp_Object
*newmodes
, *newmaps
;
1197 = (Lisp_Object
*) realloc (cmm_modes
,
1198 cmm_size
* sizeof (Lisp_Object
));
1200 = (Lisp_Object
*) realloc (cmm_maps
,
1201 cmm_size
* sizeof (Lisp_Object
));
1209 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1211 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1215 if (newmaps
&& newmodes
)
1217 cmm_modes
= newmodes
;
1224 /* Get the keymap definition--or nil if it is not defined. */
1225 temp
= internal_condition_case_1 (Findirect_function
,
1227 Qerror
, current_minor_maps_error
);
1231 cmm_maps
[i
] = temp
;
1236 if (modeptr
) *modeptr
= cmm_modes
;
1237 if (mapptr
) *mapptr
= cmm_maps
;
1241 /* GC is possible in this function if it autoloads a keymap. */
1243 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 2, 0,
1244 "Return the binding for command KEY in current keymaps.\n\
1245 KEY is a string or vector, a sequence of keystrokes.\n\
1246 The binding is probably a symbol with a function definition.\n\
1248 Normally, `key-binding' ignores bindings for t, which act as default\n\
1249 bindings, used when nothing else in the keymap applies; this makes it\n\
1250 usable as a general function for probing keymaps. However, if the\n\
1251 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1252 recognize the default bindings, just as `read-key-sequence' does.")
1253 (key
, accept_default
)
1254 Lisp_Object key
, accept_default
;
1256 Lisp_Object
*maps
, value
;
1258 struct gcpro gcpro1
;
1262 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1264 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1265 key
, accept_default
);
1266 if (! NILP (value
) && !INTEGERP (value
))
1267 RETURN_UNGCPRO (value
);
1269 else if (!NILP (Voverriding_local_map
))
1271 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1272 if (! NILP (value
) && !INTEGERP (value
))
1273 RETURN_UNGCPRO (value
);
1279 nmaps
= current_minor_maps (0, &maps
);
1280 /* Note that all these maps are GCPRO'd
1281 in the places where we found them. */
1283 for (i
= 0; i
< nmaps
; i
++)
1284 if (! NILP (maps
[i
]))
1286 value
= Flookup_key (maps
[i
], key
, accept_default
);
1287 if (! NILP (value
) && !INTEGERP (value
))
1288 RETURN_UNGCPRO (value
);
1291 local
= get_local_map (PT
, current_buffer
);
1295 value
= Flookup_key (local
, key
, accept_default
);
1296 if (! NILP (value
) && !INTEGERP (value
))
1297 RETURN_UNGCPRO (value
);
1301 value
= Flookup_key (current_global_map
, key
, accept_default
);
1303 if (! NILP (value
) && !INTEGERP (value
))
1309 /* GC is possible in this function if it autoloads a keymap. */
1311 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1312 "Return the binding for command KEYS in current local keymap only.\n\
1313 KEYS is a string, a sequence of keystrokes.\n\
1314 The binding is probably a symbol with a function definition.\n\
1316 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1317 bindings; see the description of `lookup-key' for more details about this.")
1318 (keys
, accept_default
)
1319 Lisp_Object keys
, accept_default
;
1321 register Lisp_Object map
;
1322 map
= current_buffer
->keymap
;
1325 return Flookup_key (map
, keys
, accept_default
);
1328 /* GC is possible in this function if it autoloads a keymap. */
1330 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1331 "Return the binding for command KEYS in current global keymap only.\n\
1332 KEYS is a string, a sequence of keystrokes.\n\
1333 The binding is probably a symbol with a function definition.\n\
1334 This function's return values are the same as those of lookup-key\n\
1337 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1338 bindings; see the description of `lookup-key' for more details about this.")
1339 (keys
, accept_default
)
1340 Lisp_Object keys
, accept_default
;
1342 return Flookup_key (current_global_map
, keys
, accept_default
);
1345 /* GC is possible in this function if it autoloads a keymap. */
1347 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1348 "Find the visible minor mode bindings of KEY.\n\
1349 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1350 the symbol which names the minor mode binding KEY, and BINDING is\n\
1351 KEY's definition in that mode. In particular, if KEY has no\n\
1352 minor-mode bindings, return nil. If the first binding is a\n\
1353 non-prefix, all subsequent bindings will be omitted, since they would\n\
1354 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1355 that come after prefix bindings.\n\
1357 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1358 bindings; see the description of `lookup-key' for more details about this.")
1359 (key
, accept_default
)
1360 Lisp_Object key
, accept_default
;
1362 Lisp_Object
*modes
, *maps
;
1364 Lisp_Object binding
;
1366 struct gcpro gcpro1
, gcpro2
;
1368 nmaps
= current_minor_maps (&modes
, &maps
);
1369 /* Note that all these maps are GCPRO'd
1370 in the places where we found them. */
1373 GCPRO2 (key
, binding
);
1375 for (i
= j
= 0; i
< nmaps
; i
++)
1376 if (! NILP (maps
[i
])
1377 && ! NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1378 && !INTEGERP (binding
))
1380 if (! NILP (get_keymap (binding
)))
1381 maps
[j
++] = Fcons (modes
[i
], binding
);
1383 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1387 return Flist (j
, maps
);
1390 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1391 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1392 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1393 If a second optional argument MAPVAR is given, the map is stored as\n\
1394 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1396 The third optional argument NAME, if given, supplies a menu name\n\
1397 string for the map. This is required to use the keymap as a menu.")
1398 (command
, mapvar
, name
)
1399 Lisp_Object command
, mapvar
, name
;
1402 map
= Fmake_sparse_keymap (name
);
1403 Ffset (command
, map
);
1407 Fset (command
, map
);
1411 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1412 "Select KEYMAP as the global keymap.")
1416 keymap
= get_keymap (keymap
);
1417 current_global_map
= keymap
;
1422 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1423 "Select KEYMAP as the local keymap.\n\
1424 If KEYMAP is nil, that means no local keymap.")
1429 keymap
= get_keymap (keymap
);
1431 current_buffer
->keymap
= keymap
;
1436 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1437 "Return current buffer's local keymap, or nil if it has none.")
1440 return current_buffer
->keymap
;
1443 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1444 "Return the current global keymap.")
1447 return current_global_map
;
1450 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1451 "Return a list of keymaps for the minor modes of the current buffer.")
1455 int nmaps
= current_minor_maps (0, &maps
);
1457 return Flist (nmaps
, maps
);
1460 /* Help functions for describing and documenting keymaps. */
1462 static void accessible_keymaps_char_table ();
1464 /* This function cannot GC. */
1466 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1468 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1469 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1470 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1471 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1472 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1473 then the value includes only maps for prefixes that start with PREFIX.")
1475 Lisp_Object keymap
, prefix
;
1477 Lisp_Object maps
, good_maps
, tail
;
1480 /* no need for gcpro because we don't autoload any keymaps. */
1483 prefixlen
= XINT (Flength (prefix
));
1487 /* If a prefix was specified, start with the keymap (if any) for
1488 that prefix, so we don't waste time considering other prefixes. */
1490 tem
= Flookup_key (keymap
, prefix
, Qt
);
1491 /* Flookup_key may give us nil, or a number,
1492 if the prefix is not defined in this particular map.
1493 It might even give us a list that isn't a keymap. */
1494 tem
= get_keymap_1 (tem
, 0, 0);
1497 /* Convert PREFIX to a vector now, so that later on
1498 we don't have to deal with the possibility of a string. */
1499 if (STRINGP (prefix
))
1504 copy
= Fmake_vector (make_number (XSTRING (prefix
)->size
), Qnil
);
1505 for (i
= 0, i_byte
= 0; i
< XSTRING (prefix
)->size
;)
1508 if (STRING_MULTIBYTE (prefix
))
1509 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1512 c
= XSTRING (prefix
)->data
[i
++];
1514 c
^= 0200 | meta_modifier
;
1516 XVECTOR (copy
)->contents
[i_before
] = make_number (c
);
1520 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1526 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1527 get_keymap (keymap
)),
1530 /* For each map in the list maps,
1531 look at any other maps it points to,
1532 and stick them at the end if they are not already in the list.
1534 This is a breadth-first traversal, where tail is the queue of
1535 nodes, and maps accumulates a list of all nodes visited. */
1537 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1539 register Lisp_Object thisseq
, thismap
;
1541 /* Does the current sequence end in the meta-prefix-char? */
1544 thisseq
= Fcar (Fcar (tail
));
1545 thismap
= Fcdr (Fcar (tail
));
1546 last
= make_number (XINT (Flength (thisseq
)) - 1);
1547 is_metized
= (XINT (last
) >= 0
1548 /* Don't metize the last char of PREFIX. */
1549 && XINT (last
) >= prefixlen
1550 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1552 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1556 elt
= XCAR (thismap
);
1560 if (CHAR_TABLE_P (elt
))
1562 Lisp_Object indices
[3];
1564 map_char_table (accessible_keymaps_char_table
, Qnil
,
1565 elt
, Fcons (maps
, Fcons (tail
, thisseq
)),
1568 else if (VECTORP (elt
))
1572 /* Vector keymap. Scan all the elements. */
1573 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
1575 register Lisp_Object tem
;
1576 register Lisp_Object cmd
;
1578 cmd
= get_keyelt (XVECTOR (elt
)->contents
[i
], 0);
1579 if (NILP (cmd
)) continue;
1580 tem
= Fkeymapp (cmd
);
1583 cmd
= get_keymap (cmd
);
1584 /* Ignore keymaps that are already added to maps. */
1585 tem
= Frassq (cmd
, maps
);
1588 /* If the last key in thisseq is meta-prefix-char,
1589 turn it into a meta-ized keystroke. We know
1590 that the event we're about to append is an
1591 ascii keystroke since we're processing a
1595 int meta_bit
= meta_modifier
;
1596 tem
= Fcopy_sequence (thisseq
);
1598 Faset (tem
, last
, make_number (i
| meta_bit
));
1600 /* This new sequence is the same length as
1601 thisseq, so stick it in the list right
1604 = Fcons (Fcons (tem
, cmd
), XCDR (tail
));
1608 tem
= append_key (thisseq
, make_number (i
));
1609 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1615 else if (CONSP (elt
))
1617 register Lisp_Object cmd
, tem
;
1619 cmd
= get_keyelt (XCDR (elt
), 0);
1620 /* Ignore definitions that aren't keymaps themselves. */
1621 tem
= Fkeymapp (cmd
);
1624 /* Ignore keymaps that have been seen already. */
1625 cmd
= get_keymap (cmd
);
1626 tem
= Frassq (cmd
, maps
);
1629 /* Let elt be the event defined by this map entry. */
1632 /* If the last key in thisseq is meta-prefix-char, and
1633 this entry is a binding for an ascii keystroke,
1634 turn it into a meta-ized keystroke. */
1635 if (is_metized
&& INTEGERP (elt
))
1637 Lisp_Object element
;
1640 tem
= Fvconcat (1, &element
);
1641 XSETFASTINT (XVECTOR (tem
)->contents
[XINT (last
)],
1642 XINT (elt
) | meta_modifier
);
1644 /* This new sequence is the same length as
1645 thisseq, so stick it in the list right
1648 = Fcons (Fcons (tem
, cmd
), XCDR (tail
));
1652 Fcons (Fcons (append_key (thisseq
, elt
), cmd
),
1663 /* Now find just the maps whose access prefixes start with PREFIX. */
1666 for (; CONSP (maps
); maps
= XCDR (maps
))
1668 Lisp_Object elt
, thisseq
;
1670 thisseq
= XCAR (elt
);
1671 /* The access prefix must be at least as long as PREFIX,
1672 and the first elements must match those of PREFIX. */
1673 if (XINT (Flength (thisseq
)) >= prefixlen
)
1676 for (i
= 0; i
< prefixlen
; i
++)
1679 XSETFASTINT (i1
, i
);
1680 if (!EQ (Faref (thisseq
, i1
), Faref (prefix
, i1
)))
1684 good_maps
= Fcons (elt
, good_maps
);
1688 return Fnreverse (good_maps
);
1692 accessible_keymaps_char_table (args
, index
, cmd
)
1693 Lisp_Object args
, index
, cmd
;
1696 Lisp_Object maps
, tail
, thisseq
;
1702 tail
= XCAR (XCDR (args
));
1703 thisseq
= XCDR (XCDR (args
));
1705 tem
= Fkeymapp (cmd
);
1708 cmd
= get_keymap (cmd
);
1709 /* Ignore keymaps that are already added to maps. */
1710 tem
= Frassq (cmd
, maps
);
1713 tem
= append_key (thisseq
, index
);
1714 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1719 Lisp_Object Qsingle_key_description
, Qkey_description
;
1721 /* This function cannot GC. */
1723 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1724 "Return a pretty description of key-sequence KEYS.\n\
1725 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1726 spaces are put between sequence elements, etc.")
1738 vector
= Fmake_vector (Flength (keys
), Qnil
);
1739 for (i
= 0, i_byte
= 0; i
< XSTRING (keys
)->size
; )
1744 if (STRING_MULTIBYTE (keys
))
1745 FETCH_STRING_CHAR_ADVANCE (c
, keys
, i
, i_byte
);
1748 c
= XSTRING (keys
)->data
[i
++];
1750 c
^= 0200 | meta_modifier
;
1753 XSETFASTINT (XVECTOR (vector
)->contents
[i_before
], c
);
1760 /* In effect, this computes
1761 (mapconcat 'single-key-description keys " ")
1762 but we shouldn't use mapconcat because it can do GC. */
1764 len
= XVECTOR (keys
)->size
;
1765 sep
= build_string (" ");
1766 /* This has one extra element at the end that we don't pass to Fconcat. */
1767 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1769 for (i
= 0; i
< len
; i
++)
1771 args
[i
* 2] = Fsingle_key_description (XVECTOR (keys
)->contents
[i
]);
1772 args
[i
* 2 + 1] = sep
;
1775 else if (CONSP (keys
))
1777 /* In effect, this computes
1778 (mapconcat 'single-key-description keys " ")
1779 but we shouldn't use mapconcat because it can do GC. */
1781 len
= XFASTINT (Flength (keys
));
1782 sep
= build_string (" ");
1783 /* This has one extra element at the end that we don't pass to Fconcat. */
1784 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1786 for (i
= 0; i
< len
; i
++)
1788 args
[i
* 2] = Fsingle_key_description (XCAR (keys
));
1789 args
[i
* 2 + 1] = sep
;
1794 keys
= wrong_type_argument (Qarrayp
, keys
);
1796 return Fconcat (len
* 2 - 1, args
);
1800 push_key_description (c
, p
)
1801 register unsigned int c
;
1804 /* Clear all the meaningless bits above the meta bit. */
1805 c
&= meta_modifier
| ~ - meta_modifier
;
1807 if (c
& alt_modifier
)
1813 if (c
& ctrl_modifier
)
1819 if (c
& hyper_modifier
)
1823 c
-= hyper_modifier
;
1825 if (c
& meta_modifier
)
1831 if (c
& shift_modifier
)
1835 c
-= shift_modifier
;
1837 if (c
& super_modifier
)
1841 c
-= super_modifier
;
1857 else if (c
== Ctl ('M'))
1867 if (c
> 0 && c
<= Ctl ('Z'))
1886 || (NILP (current_buffer
->enable_multibyte_characters
)
1887 && SINGLE_BYTE_CHAR_P (c
)))
1891 if (! NILP (current_buffer
->enable_multibyte_characters
))
1892 c
= unibyte_char_to_multibyte (c
);
1894 if (NILP (current_buffer
->enable_multibyte_characters
)
1895 || SINGLE_BYTE_CHAR_P (c
)
1896 || ! char_valid_p (c
, 0))
1900 /* The biggest character code uses 19 bits. */
1901 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
1903 if (c
>= (1 << bit_offset
))
1904 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
1909 unsigned char work
[4], *str
;
1910 int i
= CHAR_STRING (c
, work
, str
);
1919 /* This function cannot GC. */
1921 DEFUN ("single-key-description", Fsingle_key_description
, Ssingle_key_description
, 1, 1, 0,
1922 "Return a pretty description of command character KEY.\n\
1923 Control characters turn into C-whatever, etc.")
1927 if (CONSP (key
) && lucid_event_type_list_p (key
))
1928 key
= Fevent_convert_list (key
);
1930 key
= EVENT_HEAD (key
);
1932 if (INTEGERP (key
)) /* Normal character */
1934 unsigned int charset
, c1
, c2
;
1935 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
1937 if (SINGLE_BYTE_CHAR_P (without_bits
))
1940 SPLIT_NON_ASCII_CHAR (without_bits
, charset
, c1
, c2
);
1943 && CHARSET_DEFINED_P (charset
)
1944 && ((c1
>= 0 && c1
< 32)
1945 || (c2
>= 0 && c2
< 32)))
1947 /* Handle a generic character. */
1949 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
1950 CHECK_STRING (name
, 0);
1951 return concat2 (build_string ("Character set "), name
);
1957 *push_key_description (XUINT (key
), tem
) = 0;
1958 return build_string (tem
);
1961 else if (SYMBOLP (key
)) /* Function key or event-symbol */
1962 return Fsymbol_name (key
);
1963 else if (STRINGP (key
)) /* Buffer names in the menubar. */
1964 return Fcopy_sequence (key
);
1966 error ("KEY must be an integer, cons, symbol, or string");
1970 push_text_char_description (c
, p
)
1971 register unsigned int c
;
1983 *p
++ = c
+ 64; /* 'A' - 1 */
1995 /* This function cannot GC. */
1997 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
1998 "Return a pretty description of file-character CHARACTER.\n\
1999 Control characters turn into \"^char\", etc.")
2001 Lisp_Object character
;
2005 CHECK_NUMBER (character
, 0);
2007 if (!SINGLE_BYTE_CHAR_P (XFASTINT (character
)))
2010 int len
= non_ascii_char_to_string (XFASTINT (character
), tem
, &str
);
2012 return make_multibyte_string (str
, 1, len
);
2015 *push_text_char_description (XINT (character
) & 0377, tem
) = 0;
2017 return build_string (tem
);
2020 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2023 ascii_sequence_p (seq
)
2027 int len
= XINT (Flength (seq
));
2029 for (i
= 0; i
< len
; i
++)
2031 Lisp_Object ii
, elt
;
2033 XSETFASTINT (ii
, i
);
2034 elt
= Faref (seq
, ii
);
2037 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2045 /* where-is - finding a command in a set of keymaps. */
2047 static Lisp_Object
where_is_internal_1 ();
2048 static void where_is_internal_2 ();
2050 /* This function can GC if Flookup_key autoloads any keymaps. */
2052 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 4, 0,
2053 "Return list of keys that invoke DEFINITION.\n\
2054 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2055 If KEYMAP is nil, search all the currently active keymaps.\n\
2057 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2058 rather than a list of all possible key sequences.\n\
2059 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2060 no matter what it is.\n\
2061 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2062 and entirely reject menu bindings.\n\
2064 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2065 to other keymaps or slots. This makes it possible to search for an\n\
2066 indirect definition itself.")
2067 (definition
, keymap
, firstonly
, noindirect
)
2068 Lisp_Object definition
, keymap
;
2069 Lisp_Object firstonly
, noindirect
;
2072 Lisp_Object found
, sequences
;
2073 Lisp_Object keymap1
;
2074 int keymap_specified
= !NILP (keymap
);
2075 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2076 /* 1 means ignore all menu bindings entirely. */
2077 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2079 /* Find keymaps accessible from `keymap' or the current
2080 context. But don't muck with the value of `keymap',
2081 because `where_is_internal_1' uses it to check for
2082 shadowed bindings. */
2084 if (! keymap_specified
)
2086 #ifdef USE_TEXT_PROPERTIES
2087 keymap1
= get_local_map (PT
, current_buffer
);
2089 keymap1
= current_buffer
->keymap
;
2093 if (!NILP (keymap1
))
2094 maps
= nconc2 (Faccessible_keymaps (get_keymap (keymap1
), Qnil
),
2095 Faccessible_keymaps (get_keymap (current_global_map
),
2098 maps
= Faccessible_keymaps (get_keymap (current_global_map
), Qnil
);
2100 /* Put the minor mode keymaps on the front. */
2101 if (! keymap_specified
)
2104 minors
= Fnreverse (Fcurrent_minor_mode_maps ());
2105 while (!NILP (minors
))
2107 maps
= nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors
)),
2110 minors
= XCDR (minors
);
2114 GCPRO5 (definition
, keymap
, maps
, found
, sequences
);
2118 for (; !NILP (maps
); maps
= Fcdr (maps
))
2120 /* Key sequence to reach map, and the map that it reaches */
2121 register Lisp_Object
this, map
;
2123 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2124 [M-CHAR] sequences, check if last character of the sequence
2125 is the meta-prefix char. */
2129 this = Fcar (Fcar (maps
));
2130 map
= Fcdr (Fcar (maps
));
2131 last
= make_number (XINT (Flength (this)) - 1);
2132 last_is_meta
= (XINT (last
) >= 0
2133 && EQ (Faref (this, last
), meta_prefix_char
));
2139 /* Because the code we want to run on each binding is rather
2140 large, we don't want to have two separate loop bodies for
2141 sparse keymap bindings and tables; we want to iterate one
2142 loop body over both keymap and vector bindings.
2144 For this reason, if Fcar (map) is a vector, we don't
2145 advance map to the next element until i indicates that we
2146 have finished off the vector. */
2147 Lisp_Object elt
, key
, binding
;
2155 /* Set key and binding to the current key and binding, and
2156 advance map and i to the next binding. */
2159 Lisp_Object sequence
;
2161 /* In a vector, look at each element. */
2162 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2164 binding
= XVECTOR (elt
)->contents
[i
];
2165 XSETFASTINT (key
, i
);
2166 sequence
= where_is_internal_1 (binding
, key
, definition
,
2167 noindirect
, keymap
, this,
2168 last
, nomenus
, last_is_meta
);
2169 if (!NILP (sequence
))
2170 sequences
= Fcons (sequence
, sequences
);
2173 else if (CHAR_TABLE_P (elt
))
2175 Lisp_Object indices
[3];
2178 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2179 Fcons (keymap
, Qnil
)),
2180 Fcons (Fcons (this, last
),
2181 Fcons (make_number (nomenus
),
2182 make_number (last_is_meta
))));
2184 map_char_table (where_is_internal_2
, Qnil
, elt
, args
,
2186 sequences
= XCDR (XCDR (XCAR (args
)));
2188 else if (CONSP (elt
))
2190 Lisp_Object sequence
;
2193 binding
= XCDR (elt
);
2195 sequence
= where_is_internal_1 (binding
, key
, definition
,
2196 noindirect
, keymap
, this,
2197 last
, nomenus
, last_is_meta
);
2198 if (!NILP (sequence
))
2199 sequences
= Fcons (sequence
, sequences
);
2203 for (; ! NILP (sequences
); sequences
= XCDR (sequences
))
2205 Lisp_Object sequence
;
2207 sequence
= XCAR (sequences
);
2209 /* It is a true unshadowed match. Record it, unless it's already
2210 been seen (as could happen when inheriting keymaps). */
2211 if (NILP (Fmember (sequence
, found
)))
2212 found
= Fcons (sequence
, found
);
2214 /* If firstonly is Qnon_ascii, then we can return the first
2215 binding we find. If firstonly is not Qnon_ascii but not
2216 nil, then we should return the first ascii-only binding
2218 if (EQ (firstonly
, Qnon_ascii
))
2219 RETURN_UNGCPRO (sequence
);
2220 else if (! NILP (firstonly
) && ascii_sequence_p (sequence
))
2221 RETURN_UNGCPRO (sequence
);
2228 found
= Fnreverse (found
);
2230 /* firstonly may have been t, but we may have gone all the way through
2231 the keymaps without finding an all-ASCII key sequence. So just
2232 return the best we could find. */
2233 if (! NILP (firstonly
))
2234 return Fcar (found
);
2239 /* This is the function that Fwhere_is_internal calls using map_char_table.
2241 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2243 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2244 Since map_char_table doesn't really use the return value from this function,
2245 we the result append to RESULT, the slot in ARGS. */
2248 where_is_internal_2 (args
, key
, binding
)
2249 Lisp_Object args
, key
, binding
;
2251 Lisp_Object definition
, noindirect
, keymap
, this, last
;
2252 Lisp_Object result
, sequence
;
2253 int nomenus
, last_is_meta
;
2255 result
= XCDR (XCDR (XCAR (args
)));
2256 definition
= XCAR (XCAR (XCAR (args
)));
2257 noindirect
= XCDR (XCAR (XCAR (args
)));
2258 keymap
= XCAR (XCDR (XCAR (args
)));
2259 this = XCAR (XCAR (XCDR (args
)));
2260 last
= XCDR (XCAR (XCDR (args
)));
2261 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2262 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2264 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
,
2265 this, last
, nomenus
, last_is_meta
);
2267 if (!NILP (sequence
))
2268 XCDR (XCDR (XCAR (args
)))
2269 = Fcons (sequence
, result
);
2273 where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
, this, last
,
2274 nomenus
, last_is_meta
)
2275 Lisp_Object binding
, key
, definition
, noindirect
, keymap
, this, last
;
2276 int nomenus
, last_is_meta
;
2278 Lisp_Object sequence
;
2279 int keymap_specified
= !NILP (keymap
);
2281 /* Search through indirections unless that's not wanted. */
2282 if (NILP (noindirect
))
2288 Lisp_Object map
, tem
;
2289 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2290 map
= get_keymap_1 (Fcar_safe (definition
), 0, 0);
2291 tem
= Fkeymapp (map
);
2293 definition
= access_keymap (map
, Fcdr (definition
), 0, 0);
2297 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2298 if (CONSP (definition
)
2299 && (EQ (XCAR (definition
),Qmenu_item
)
2300 || STRINGP (XCAR (definition
))))
2304 binding
= get_keyelt (binding
, 0);
2307 /* End this iteration if this element does not match
2310 if (CONSP (definition
))
2313 tem
= Fequal (binding
, definition
);
2318 if (!EQ (binding
, definition
))
2321 /* We have found a match.
2322 Construct the key sequence where we found it. */
2323 if (INTEGERP (key
) && last_is_meta
)
2325 sequence
= Fcopy_sequence (this);
2326 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2329 sequence
= append_key (this, key
);
2331 /* Verify that this key binding is not shadowed by another
2332 binding for the same key, before we say it exists.
2334 Mechanism: look for local definition of this key and if
2335 it is defined and does not match what we found then
2338 Either nil or number as value from Flookup_key
2340 if (keymap_specified
)
2342 binding
= Flookup_key (keymap
, sequence
, Qnil
);
2343 if (!NILP (binding
) && !INTEGERP (binding
))
2345 if (CONSP (definition
))
2348 tem
= Fequal (binding
, definition
);
2353 if (!EQ (binding
, definition
))
2359 binding
= Fkey_binding (sequence
, Qnil
);
2360 if (!EQ (binding
, definition
))
2367 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2369 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal
, Sdescribe_bindings_internal
, 0, 2, "",
2370 "Show a list of all defined keys, and their definitions.\n\
2371 We put that list in a buffer, and display the buffer.\n\
2373 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2374 \(Ordinarily these are omitted from the output.)\n\
2375 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2376 then we display only bindings that start with that prefix.")
2378 Lisp_Object menus
, prefix
;
2380 register Lisp_Object thisbuf
;
2381 XSETBUFFER (thisbuf
, current_buffer
);
2382 internal_with_output_to_temp_buffer ("*Help*",
2383 describe_buffer_bindings
,
2384 list3 (thisbuf
, prefix
, menus
));
2388 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2391 describe_buffer_bindings (arg
)
2394 Lisp_Object descbuf
, prefix
, shadow
;
2396 register Lisp_Object start1
;
2397 struct gcpro gcpro1
;
2399 char *alternate_heading
2401 Keyboard translations:\n\n\
2402 You type Translation\n\
2403 -------- -----------\n";
2405 descbuf
= XCAR (arg
);
2407 prefix
= XCAR (arg
);
2409 nomenu
= NILP (XCAR (arg
));
2414 Fset_buffer (Vstandard_output
);
2416 /* Report on alternates for keys. */
2417 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2420 unsigned char *translate
= XSTRING (Vkeyboard_translate_table
)->data
;
2421 int translate_len
= XSTRING (Vkeyboard_translate_table
)->size
;
2423 for (c
= 0; c
< translate_len
; c
++)
2424 if (translate
[c
] != c
)
2429 if (alternate_heading
)
2431 insert_string (alternate_heading
);
2432 alternate_heading
= 0;
2435 bufend
= push_key_description (translate
[c
], buf
);
2436 insert (buf
, bufend
- buf
);
2437 Findent_to (make_number (16), make_number (1));
2438 bufend
= push_key_description (c
, buf
);
2439 insert (buf
, bufend
- buf
);
2447 if (!NILP (Vkey_translation_map
))
2448 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2449 "Key translations", nomenu
, 1, 0);
2453 Lisp_Object
*modes
, *maps
;
2455 /* Temporarily switch to descbuf, so that we can get that buffer's
2456 minor modes correctly. */
2457 Fset_buffer (descbuf
);
2459 if (!NILP (current_kboard
->Voverriding_terminal_local_map
)
2460 || !NILP (Voverriding_local_map
))
2463 nmaps
= current_minor_maps (&modes
, &maps
);
2464 Fset_buffer (Vstandard_output
);
2466 /* Print the minor mode maps. */
2467 for (i
= 0; i
< nmaps
; i
++)
2469 /* The title for a minor mode keymap
2470 is constructed at run time.
2471 We let describe_map_tree do the actual insertion
2472 because it takes care of other features when doing so. */
2475 if (!SYMBOLP (modes
[i
]))
2478 p
= title
= (char *) alloca (40 + XSYMBOL (modes
[i
])->name
->size
);
2480 bcopy (XSYMBOL (modes
[i
])->name
->data
, p
,
2481 XSYMBOL (modes
[i
])->name
->size
);
2482 p
+= XSYMBOL (modes
[i
])->name
->size
;
2484 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2485 p
+= sizeof (" Minor Mode Bindings") - 1;
2488 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2489 shadow
= Fcons (maps
[i
], shadow
);
2493 /* Print the (major mode) local map. */
2494 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2495 start1
= current_kboard
->Voverriding_terminal_local_map
;
2496 else if (!NILP (Voverriding_local_map
))
2497 start1
= Voverriding_local_map
;
2499 start1
= XBUFFER (descbuf
)->keymap
;
2503 describe_map_tree (start1
, 1, shadow
, prefix
,
2504 "Major Mode Bindings", nomenu
, 0, 0);
2505 shadow
= Fcons (start1
, shadow
);
2508 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2509 "Global Bindings", nomenu
, 0, 1);
2511 /* Print the function-key-map translations under this prefix. */
2512 if (!NILP (Vfunction_key_map
))
2513 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2514 "Function key map translations", nomenu
, 1, 0);
2516 call0 (intern ("help-mode"));
2517 Fset_buffer (descbuf
);
2522 /* Insert a description of the key bindings in STARTMAP,
2523 followed by those of all maps reachable through STARTMAP.
2524 If PARTIAL is nonzero, omit certain "uninteresting" commands
2525 (such as `undefined').
2526 If SHADOW is non-nil, it is a list of maps;
2527 don't mention keys which would be shadowed by any of them.
2528 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2529 TITLE, if not 0, is a string to insert at the beginning.
2530 TITLE should not end with a colon or a newline; we supply that.
2531 If NOMENU is not 0, then omit menu-bar commands.
2533 If TRANSL is nonzero, the definitions are actually key translations
2534 so print strings and vectors differently.
2536 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2540 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2542 Lisp_Object startmap
, shadow
, prefix
;
2549 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2550 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2557 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2560 GCPRO3 (maps
, seen
, sub_shadows
);
2566 /* Delete from MAPS each element that is for the menu bar. */
2567 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2569 Lisp_Object elt
, prefix
, tem
;
2572 prefix
= Fcar (elt
);
2573 if (XVECTOR (prefix
)->size
>= 1)
2575 tem
= Faref (prefix
, make_number (0));
2576 if (EQ (tem
, Qmenu_bar
))
2577 maps
= Fdelq (elt
, maps
);
2582 if (!NILP (maps
) || always_title
)
2586 insert_string (title
);
2589 insert_string (" Starting With ");
2590 insert1 (Fkey_description (prefix
));
2592 insert_string (":\n");
2594 insert_string (key_heading
);
2598 for (; !NILP (maps
); maps
= Fcdr (maps
))
2600 register Lisp_Object elt
, prefix
, tail
;
2603 prefix
= Fcar (elt
);
2607 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2611 shmap
= XCAR (tail
);
2613 /* If the sequence by which we reach this keymap is zero-length,
2614 then the shadow map for this keymap is just SHADOW. */
2615 if ((STRINGP (prefix
) && XSTRING (prefix
)->size
== 0)
2616 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2618 /* If the sequence by which we reach this keymap actually has
2619 some elements, then the sequence's definition in SHADOW is
2620 what we should use. */
2623 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2624 if (INTEGERP (shmap
))
2628 /* If shmap is not nil and not a keymap,
2629 it completely shadows this map, so don't
2630 describe this map at all. */
2631 if (!NILP (shmap
) && NILP (Fkeymapp (shmap
)))
2635 sub_shadows
= Fcons (shmap
, sub_shadows
);
2638 /* Maps we have already listed in this loop shadow this map. */
2639 for (tail
= orig_maps
; ! EQ (tail
, maps
); tail
= XCDR (tail
))
2642 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
2644 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
2647 describe_map (Fcdr (elt
), prefix
,
2648 transl
? describe_translation
: describe_command
,
2649 partial
, sub_shadows
, &seen
, nomenu
);
2655 insert_string ("\n");
2660 static int previous_description_column
;
2663 describe_command (definition
)
2664 Lisp_Object definition
;
2666 register Lisp_Object tem1
;
2667 int column
= current_column ();
2668 int description_column
;
2670 /* If column 16 is no good, go to col 32;
2671 but don't push beyond that--go to next line instead. */
2675 description_column
= 32;
2677 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
2678 description_column
= 32;
2680 description_column
= 16;
2682 Findent_to (make_number (description_column
), make_number (1));
2683 previous_description_column
= description_column
;
2685 if (SYMBOLP (definition
))
2687 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2689 insert_string ("\n");
2691 else if (STRINGP (definition
) || VECTORP (definition
))
2692 insert_string ("Keyboard Macro\n");
2695 tem1
= Fkeymapp (definition
);
2697 insert_string ("Prefix Command\n");
2699 insert_string ("??\n");
2704 describe_translation (definition
)
2705 Lisp_Object definition
;
2707 register Lisp_Object tem1
;
2709 Findent_to (make_number (16), make_number (1));
2711 if (SYMBOLP (definition
))
2713 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2715 insert_string ("\n");
2717 else if (STRINGP (definition
) || VECTORP (definition
))
2719 insert1 (Fkey_description (definition
));
2720 insert_string ("\n");
2724 tem1
= Fkeymapp (definition
);
2726 insert_string ("Prefix Command\n");
2728 insert_string ("??\n");
2732 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2733 Returns the first non-nil binding found in any of those maps. */
2736 shadow_lookup (shadow
, key
, flag
)
2737 Lisp_Object shadow
, key
, flag
;
2739 Lisp_Object tail
, value
;
2741 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2743 value
= Flookup_key (XCAR (tail
), key
, flag
);
2750 /* Describe the contents of map MAP, assuming that this map itself is
2751 reached by the sequence of prefix keys KEYS (a string or vector).
2752 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2755 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
2756 register Lisp_Object map
;
2758 void (*elt_describer
) P_ ((Lisp_Object
));
2764 Lisp_Object elt_prefix
;
2765 Lisp_Object tail
, definition
, event
;
2767 Lisp_Object suppress
;
2770 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2772 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
2774 /* Call Fkey_description first, to avoid GC bug for the other string. */
2775 tem
= Fkey_description (keys
);
2776 elt_prefix
= concat2 (tem
, build_string (" "));
2782 suppress
= intern ("suppress-keymap");
2784 /* This vector gets used to present single keys to Flookup_key. Since
2785 that is done once per keymap element, we don't want to cons up a
2786 fresh vector every time. */
2787 kludge
= Fmake_vector (make_number (1), Qnil
);
2790 GCPRO3 (elt_prefix
, definition
, kludge
);
2792 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
2796 if (VECTORP (XCAR (tail
))
2797 || CHAR_TABLE_P (XCAR (tail
)))
2798 describe_vector (XCAR (tail
),
2799 elt_prefix
, elt_describer
, partial
, shadow
, map
,
2801 else if (CONSP (XCAR (tail
)))
2803 event
= XCAR (XCAR (tail
));
2805 /* Ignore bindings whose "keys" are not really valid events.
2806 (We get these in the frames and buffers menu.) */
2807 if (! (SYMBOLP (event
) || INTEGERP (event
)))
2810 if (nomenu
&& EQ (event
, Qmenu_bar
))
2813 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
2815 /* Don't show undefined commands or suppressed commands. */
2816 if (NILP (definition
)) continue;
2817 if (SYMBOLP (definition
) && partial
)
2819 tem
= Fget (definition
, suppress
);
2824 /* Don't show a command that isn't really visible
2825 because a local definition of the same key shadows it. */
2827 XVECTOR (kludge
)->contents
[0] = event
;
2830 tem
= shadow_lookup (shadow
, kludge
, Qt
);
2831 if (!NILP (tem
)) continue;
2834 tem
= Flookup_key (map
, kludge
, Qt
);
2835 if (! EQ (tem
, definition
)) continue;
2839 previous_description_column
= 0;
2844 if (!NILP (elt_prefix
))
2845 insert1 (elt_prefix
);
2847 /* THIS gets the string to describe the character EVENT. */
2848 insert1 (Fsingle_key_description (event
));
2850 /* Print a description of the definition of this character.
2851 elt_describer will take care of spacing out far enough
2852 for alignment purposes. */
2853 (*elt_describer
) (definition
);
2855 else if (EQ (XCAR (tail
), Qkeymap
))
2857 /* The same keymap might be in the structure twice, if we're
2858 using an inherited keymap. So skip anything we've already
2860 tem
= Fassq (tail
, *seen
);
2861 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), keys
)))
2863 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
2871 describe_vector_princ (elt
)
2874 Findent_to (make_number (16), make_number (1));
2879 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 1, 0,
2880 "Insert a description of contents of VECTOR.\n\
2881 This is text showing the elements of vector matched against indices.")
2885 int count
= specpdl_ptr
- specpdl
;
2887 specbind (Qstandard_output
, Fcurrent_buffer ());
2888 CHECK_VECTOR_OR_CHAR_TABLE (vector
, 0);
2889 describe_vector (vector
, Qnil
, describe_vector_princ
, 0,
2890 Qnil
, Qnil
, (int *)0, 0);
2892 return unbind_to (count
, Qnil
);
2895 /* Insert in the current buffer a description of the contents of VECTOR.
2896 We call ELT_DESCRIBER to insert the description of one value found
2899 ELT_PREFIX describes what "comes before" the keys or indices defined
2900 by this vector. This is a human-readable string whose size
2901 is not necessarily related to the situation.
2903 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2904 leads to this keymap.
2906 If the vector is a chartable, ELT_PREFIX is the vector
2907 of bytes that lead to the character set or portion of a character
2908 set described by this chartable.
2910 If PARTIAL is nonzero, it means do not mention suppressed commands
2911 (that assumes the vector is in a keymap).
2913 SHADOW is a list of keymaps that shadow this map.
2914 If it is non-nil, then we look up the key in those maps
2915 and we don't mention it now if it is defined by any of them.
2917 ENTIRE_MAP is the keymap in which this vector appears.
2918 If the definition in effect in the whole map does not match
2919 the one in this vector, we ignore this one.
2921 When describing a sub-char-table, INDICES is a list of
2922 indices at higher levels in this char-table,
2923 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2926 describe_vector (vector
, elt_prefix
, elt_describer
,
2927 partial
, shadow
, entire_map
,
2928 indices
, char_table_depth
)
2929 register Lisp_Object vector
;
2930 Lisp_Object elt_prefix
;
2931 void (*elt_describer
) P_ ((Lisp_Object
));
2934 Lisp_Object entire_map
;
2936 int char_table_depth
;
2938 Lisp_Object definition
;
2941 Lisp_Object suppress
;
2944 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2945 /* Range of elements to be handled. */
2947 /* A flag to tell if a leaf in this level of char-table is not a
2948 generic character (i.e. a complete multibyte character). */
2954 indices
= (int *) alloca (3 * sizeof (int));
2958 /* This vector gets used to present single keys to Flookup_key. Since
2959 that is done once per vector element, we don't want to cons up a
2960 fresh vector every time. */
2961 kludge
= Fmake_vector (make_number (1), Qnil
);
2962 GCPRO3 (elt_prefix
, definition
, kludge
);
2965 suppress
= intern ("suppress-keymap");
2967 if (CHAR_TABLE_P (vector
))
2969 if (char_table_depth
== 0)
2971 /* VECTOR is a top level char-table. */
2974 to
= CHAR_TABLE_ORDINARY_SLOTS
;
2978 /* VECTOR is a sub char-table. */
2979 if (char_table_depth
>= 3)
2980 /* A char-table is never that deep. */
2981 error ("Too deep char table");
2984 = (CHARSET_VALID_P (indices
[0])
2985 && ((CHARSET_DIMENSION (indices
[0]) == 1
2986 && char_table_depth
== 1)
2987 || char_table_depth
== 2));
2989 /* Meaningful elements are from 32th to 127th. */
2991 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
2996 /* This does the right thing for ordinary vectors. */
3000 to
= XVECTOR (vector
)->size
;
3003 for (i
= from
; i
< to
; i
++)
3007 if (CHAR_TABLE_P (vector
))
3009 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3012 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3013 && !CHARSET_DEFINED_P (i
- 128))
3017 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3020 definition
= get_keyelt (XVECTOR (vector
)->contents
[i
], 0);
3022 if (NILP (definition
)) continue;
3024 /* Don't mention suppressed commands. */
3025 if (SYMBOLP (definition
) && partial
)
3029 tem
= Fget (definition
, suppress
);
3031 if (!NILP (tem
)) continue;
3034 /* Set CHARACTER to the character this entry describes, if any.
3035 Also update *INDICES. */
3036 if (CHAR_TABLE_P (vector
))
3038 indices
[char_table_depth
] = i
;
3040 if (char_table_depth
== 0)
3043 indices
[0] = i
- 128;
3045 else if (complete_char
)
3048 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
3056 /* If this binding is shadowed by some other map, ignore it. */
3057 if (!NILP (shadow
) && complete_char
)
3061 XVECTOR (kludge
)->contents
[0] = make_number (character
);
3062 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3064 if (!NILP (tem
)) continue;
3067 /* Ignore this definition if it is shadowed by an earlier
3068 one in the same keymap. */
3069 if (!NILP (entire_map
) && complete_char
)
3073 XVECTOR (kludge
)->contents
[0] = make_number (character
);
3074 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3076 if (! EQ (tem
, definition
))
3082 if (char_table_depth
== 0)
3087 /* For a sub char-table, show the depth by indentation.
3088 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3089 if (char_table_depth
> 0)
3090 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3092 /* Output the prefix that applies to every entry in this map. */
3093 if (!NILP (elt_prefix
))
3094 insert1 (elt_prefix
);
3096 /* Insert or describe the character this slot is for,
3097 or a description of what it is for. */
3098 if (SUB_CHAR_TABLE_P (vector
))
3101 insert_char (character
);
3104 /* We need an octal representation for this block of
3107 sprintf (work
, "(row %d)", i
);
3108 insert (work
, strlen (work
));
3111 else if (CHAR_TABLE_P (vector
))
3114 insert1 (Fsingle_key_description (make_number (character
)));
3117 /* Print the information for this character set. */
3118 insert_string ("<");
3119 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3121 insert_from_string (tem2
, 0, 0, XSTRING (tem2
)->size
,
3122 STRING_BYTES (XSTRING (tem2
)), 0);
3130 insert1 (Fsingle_key_description (make_number (character
)));
3133 /* If we find a sub char-table within a char-table,
3134 scan it recursively; it defines the details for
3135 a character set or a portion of a character set. */
3136 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3139 describe_vector (definition
, elt_prefix
, elt_describer
,
3140 partial
, shadow
, entire_map
,
3141 indices
, char_table_depth
+ 1);
3147 /* Find all consecutive characters or rows that have the same
3148 definition. But, for elements of a top level char table, if
3149 they are for charsets, we had better describe one by one even
3150 if they have the same definition. */
3151 if (CHAR_TABLE_P (vector
))
3155 if (char_table_depth
== 0)
3156 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3158 while (i
+ 1 < limit
3159 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3161 && !NILP (Fequal (tem2
, definition
)))
3166 && (tem2
= get_keyelt (XVECTOR (vector
)->contents
[i
+ 1], 0),
3168 && !NILP (Fequal (tem2
, definition
)))
3172 /* If we have a range of more than one character,
3173 print where the range reaches to. */
3175 if (i
!= starting_i
)
3179 if (!NILP (elt_prefix
))
3180 insert1 (elt_prefix
);
3182 if (CHAR_TABLE_P (vector
))
3184 if (char_table_depth
== 0)
3186 insert1 (Fsingle_key_description (make_number (i
)));
3188 else if (complete_char
)
3190 indices
[char_table_depth
] = i
;
3192 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
3193 insert_char (character
);
3197 /* We need an octal representation for this block of
3200 sprintf (work
, "(row %d)", i
);
3201 insert (work
, strlen (work
));
3206 insert1 (Fsingle_key_description (make_number (i
)));
3210 /* Print a description of the definition of this character.
3211 elt_describer will take care of spacing out far enough
3212 for alignment purposes. */
3213 (*elt_describer
) (definition
);
3216 /* For (sub) char-table, print `defalt' slot at last. */
3217 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3219 insert (" ", char_table_depth
* 2);
3220 insert_string ("<<default>>");
3221 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
);
3227 /* Apropos - finding all symbols whose names match a regexp. */
3228 Lisp_Object apropos_predicate
;
3229 Lisp_Object apropos_accumulate
;
3232 apropos_accum (symbol
, string
)
3233 Lisp_Object symbol
, string
;
3235 register Lisp_Object tem
;
3237 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3238 if (!NILP (tem
) && !NILP (apropos_predicate
))
3239 tem
= call1 (apropos_predicate
, symbol
);
3241 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3244 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3245 "Show all symbols whose names contain match for REGEXP.\n\
3246 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3247 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3248 Return list of symbols found.")
3250 Lisp_Object regexp
, predicate
;
3252 struct gcpro gcpro1
, gcpro2
;
3253 CHECK_STRING (regexp
, 0);
3254 apropos_predicate
= predicate
;
3255 GCPRO2 (apropos_predicate
, apropos_accumulate
);
3256 apropos_accumulate
= Qnil
;
3257 map_obarray (Vobarray
, apropos_accum
, regexp
);
3258 apropos_accumulate
= Fsort (apropos_accumulate
, Qstring_lessp
);
3260 return apropos_accumulate
;
3266 Qkeymap
= intern ("keymap");
3267 staticpro (&Qkeymap
);
3269 /* Now we are ready to set up this property, so we can
3270 create char tables. */
3271 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3273 /* Initialize the keymaps standardly used.
3274 Each one is the value of a Lisp variable, and is also
3275 pointed to by a C variable */
3277 global_map
= Fmake_keymap (Qnil
);
3278 Fset (intern ("global-map"), global_map
);
3280 current_global_map
= global_map
;
3281 staticpro (&global_map
);
3282 staticpro (¤t_global_map
);
3284 meta_map
= Fmake_keymap (Qnil
);
3285 Fset (intern ("esc-map"), meta_map
);
3286 Ffset (intern ("ESC-prefix"), meta_map
);
3288 control_x_map
= Fmake_keymap (Qnil
);
3289 Fset (intern ("ctl-x-map"), control_x_map
);
3290 Ffset (intern ("Control-X-prefix"), control_x_map
);
3292 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3293 "List of commands given new key bindings recently.\n\
3294 This is used for internal purposes during Emacs startup;\n\
3295 don't alter it yourself.");
3296 Vdefine_key_rebound_commands
= Qt
;
3298 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3299 "Default keymap to use when reading from the minibuffer.");
3300 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3302 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3303 "Local keymap for the minibuffer when spaces are not allowed.");
3304 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3306 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3307 "Local keymap for minibuffer input with completion.");
3308 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3310 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3311 "Local keymap for minibuffer input with completion, for exact match.");
3312 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3314 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3315 "Alist of keymaps to use for minor modes.\n\
3316 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3317 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3318 If two active keymaps bind the same key, the keymap appearing earlier\n\
3319 in the list takes precedence.");
3320 Vminor_mode_map_alist
= Qnil
;
3322 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3323 "Alist of keymaps to use for minor modes, in current major mode.\n\
3324 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3325 used the same way (and before `minor-mode-map-alist'); however,\n\
3326 it is provided for major modes to bind locally.");
3327 Vminor_mode_overriding_map_alist
= Qnil
;
3329 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3330 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3331 This allows Emacs to recognize function keys sent from ASCII\n\
3332 terminals at any point in a key sequence.\n\
3334 The `read-key-sequence' function replaces any subsequence bound by\n\
3335 `function-key-map' with its binding. More precisely, when the active\n\
3336 keymaps have no binding for the current key sequence but\n\
3337 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3338 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3339 continues with the new sequence.\n\
3341 The events that come from bindings in `function-key-map' are not\n\
3342 themselves looked up in `function-key-map'.\n\
3344 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3345 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3346 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3347 key, typing `ESC O P x' would return [f1 x].");
3348 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3350 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3351 "Keymap of key translations that can override keymaps.\n\
3352 This keymap works like `function-key-map', but comes after that,\n\
3353 and applies even for keys that have ordinary bindings.");
3354 Vkey_translation_map
= Qnil
;
3356 Qsingle_key_description
= intern ("single-key-description");
3357 staticpro (&Qsingle_key_description
);
3359 Qkey_description
= intern ("key-description");
3360 staticpro (&Qkey_description
);
3362 Qkeymapp
= intern ("keymapp");
3363 staticpro (&Qkeymapp
);
3365 Qnon_ascii
= intern ("non-ascii");
3366 staticpro (&Qnon_ascii
);
3368 Qmenu_item
= intern ("menu-item");
3369 staticpro (&Qmenu_item
);
3371 defsubr (&Skeymapp
);
3372 defsubr (&Skeymap_parent
);
3373 defsubr (&Sset_keymap_parent
);
3374 defsubr (&Smake_keymap
);
3375 defsubr (&Smake_sparse_keymap
);
3376 defsubr (&Scopy_keymap
);
3377 defsubr (&Skey_binding
);
3378 defsubr (&Slocal_key_binding
);
3379 defsubr (&Sglobal_key_binding
);
3380 defsubr (&Sminor_mode_key_binding
);
3381 defsubr (&Sdefine_key
);
3382 defsubr (&Slookup_key
);
3383 defsubr (&Sdefine_prefix_command
);
3384 defsubr (&Suse_global_map
);
3385 defsubr (&Suse_local_map
);
3386 defsubr (&Scurrent_local_map
);
3387 defsubr (&Scurrent_global_map
);
3388 defsubr (&Scurrent_minor_mode_maps
);
3389 defsubr (&Saccessible_keymaps
);
3390 defsubr (&Skey_description
);
3391 defsubr (&Sdescribe_vector
);
3392 defsubr (&Ssingle_key_description
);
3393 defsubr (&Stext_char_description
);
3394 defsubr (&Swhere_is_internal
);
3395 defsubr (&Sdescribe_bindings_internal
);
3396 defsubr (&Sapropos_internal
);
3402 initial_define_key (global_map
, 033, "ESC-prefix");
3403 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");