1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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. */
30 #include "termhooks.h"
31 #include "blockinput.h"
34 #define min(a, b) ((a) < (b) ? (a) : (b))
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 /* Keymap mapping ASCII function key sequences onto their preferred forms.
75 Initialized by the terminal-specific lisp files. See DEFVAR for more
77 Lisp_Object Vfunction_key_map
;
79 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
80 Lisp_Object Vkey_translation_map
;
82 /* A list of all commands given new bindings since a certain time
83 when nil was stored here.
84 This is used to speed up recomputation of menu key equivalents
85 when Emacs starts up. t means don't record anything here. */
86 Lisp_Object Vdefine_key_rebound_commands
;
88 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
;
90 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
91 in a string key sequence is equivalent to prefixing with this
93 extern Lisp_Object meta_prefix_char
;
95 extern Lisp_Object Voverriding_local_map
;
97 static Lisp_Object
define_as_prefix ();
98 static Lisp_Object
describe_buffer_bindings ();
99 static void describe_command (), describe_translation ();
100 static void describe_map ();
101 Lisp_Object
Fcopy_keymap ();
103 /* Keymap object support - constructors and predicates. */
105 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
106 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
107 VECTOR is a vector which holds the bindings for the ASCII\n\
108 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
109 mouse events, and any other things that appear in the input stream.\n\
110 All entries in it are initially nil, meaning \"command undefined\".\n\n\
111 The optional arg STRING supplies a menu name for the keymap\n\
112 in case you use it as a menu with `x-popup-menu'.")
118 tail
= Fcons (string
, Qnil
);
121 return Fcons (Qkeymap
,
122 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
125 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
126 "Construct and return a new sparse-keymap list.\n\
127 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
128 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
129 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
130 Initially the alist is nil.\n\n\
131 The optional arg STRING supplies a menu name for the keymap\n\
132 in case you use it as a menu with `x-popup-menu'.")
137 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
138 return Fcons (Qkeymap
, Qnil
);
141 /* This function is used for installing the standard key bindings
142 at initialization time.
146 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
149 initial_define_key (keymap
, key
, defname
)
154 store_in_keymap (keymap
, make_number (key
), intern (defname
));
158 initial_define_lispy_key (keymap
, keyname
, defname
)
163 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
166 /* Define character fromchar in map frommap as an alias for character
167 tochar in map tomap. Subsequent redefinitions of the latter WILL
168 affect the former. */
172 synkey (frommap
, fromchar
, tomap
, tochar
)
173 struct Lisp_Vector
*frommap
, *tomap
;
174 int fromchar
, tochar
;
177 XSETVECTOR (v
, tomap
);
178 XSETFASTINT (c
, tochar
);
179 frommap
->contents
[fromchar
] = Fcons (v
, c
);
183 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
184 "Return t if OBJECT is a keymap.\n\
186 A keymap is a list (keymap . ALIST),\n\
187 or a symbol whose function definition is itself a keymap.\n\
188 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
189 a vector of densely packed bindings for small character codes\n\
190 is also allowed as an element.")
194 return (NILP (get_keymap_1 (object
, 0, 0)) ? Qnil
: Qt
);
197 /* Check that OBJECT is a keymap (after dereferencing through any
198 symbols). If it is, return it.
200 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
201 is an autoload form, do the autoload and try again.
202 If AUTOLOAD is nonzero, callers must assume GC is possible.
204 ERROR controls how we respond if OBJECT isn't a keymap.
205 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
207 Note that most of the time, we don't want to pursue autoloads.
208 Functions like Faccessible_keymaps which scan entire keymap trees
209 shouldn't load every autoloaded keymap. I'm not sure about this,
210 but it seems to me that only read_key_sequence, Flookup_key, and
211 Fdefine_key should cause keymaps to be autoloaded. */
214 get_keymap_1 (object
, error
, autoload
)
221 tem
= indirect_function (object
);
222 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, Qkeymap
))
225 /* Should we do an autoload? Autoload forms for keymaps have
226 Qkeymap as their fifth element. */
230 && EQ (XCONS (tem
)->car
, Qautoload
))
234 tail
= Fnth (make_number (4), tem
);
235 if (EQ (tail
, Qkeymap
))
237 struct gcpro gcpro1
, gcpro2
;
239 GCPRO2 (tem
, object
);
240 do_autoload (tem
, object
);
248 wrong_type_argument (Qkeymapp
, object
);
254 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
255 If OBJECT doesn't denote a keymap at all, signal an error. */
260 return get_keymap_1 (object
, 1, 0);
263 /* Return the parent map of the keymap MAP, or nil if it has none.
264 We assume that MAP is a valid keymap. */
266 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
267 "Return the parent keymap of KEYMAP.")
273 keymap
= get_keymap_1 (keymap
, 1, 1);
275 /* Skip past the initial element `keymap'. */
276 list
= XCONS (keymap
)->cdr
;
277 for (; CONSP (list
); list
= XCONS (list
)->cdr
)
279 /* See if there is another `keymap'. */
280 if (EQ (Qkeymap
, XCONS (list
)->car
))
287 /* Set the parent keymap of MAP to PARENT. */
289 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
290 "Modify KEYMAP to set its parent map to PARENT.\n\
291 PARENT should be nil or another keymap.")
293 Lisp_Object keymap
, parent
;
295 Lisp_Object list
, prev
;
298 keymap
= get_keymap_1 (keymap
, 1, 1);
300 parent
= get_keymap_1 (parent
, 1, 1);
302 /* Skip past the initial element `keymap'. */
306 list
= XCONS (prev
)->cdr
;
307 /* If there is a parent keymap here, replace it.
308 If we came to the end, add the parent in PREV. */
309 if (! CONSP (list
) || EQ (Qkeymap
, XCONS (list
)->car
))
311 /* If we already have the right parent, return now
312 so that we avoid the loops below. */
313 if (EQ (XCONS (prev
)->cdr
, parent
))
316 XCONS (prev
)->cdr
= parent
;
322 /* Scan through for submaps, and set their parents too. */
324 for (list
= XCONS (keymap
)->cdr
; CONSP (list
); list
= XCONS (list
)->cdr
)
326 /* Stop the scan when we come to the parent. */
327 if (EQ (XCONS (list
)->car
, Qkeymap
))
330 /* If this element holds a prefix map, deal with it. */
331 if (CONSP (XCONS (list
)->car
)
332 && CONSP (XCONS (XCONS (list
)->car
)->cdr
))
333 fix_submap_inheritance (keymap
, XCONS (XCONS (list
)->car
)->car
,
334 XCONS (XCONS (list
)->car
)->cdr
);
336 if (VECTORP (XCONS (list
)->car
))
337 for (i
= 0; i
< XVECTOR (XCONS (list
)->car
)->size
; i
++)
338 if (CONSP (XVECTOR (XCONS (list
)->car
)->contents
[i
]))
339 fix_submap_inheritance (keymap
, make_number (i
),
340 XVECTOR (XCONS (list
)->car
)->contents
[i
]);
342 if (CHAR_TABLE_P (XCONS (list
)->car
))
345 = (Lisp_Object
*) alloca (3 * sizeof (Lisp_Object
));
347 map_char_table (fix_submap_inheritance
, Qnil
, XCONS (list
)->car
,
355 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
356 if EVENT is also a prefix in MAP's parent,
357 make sure that SUBMAP inherits that definition as its own parent. */
359 fix_submap_inheritance (map
, event
, submap
)
360 Lisp_Object map
, event
, submap
;
362 Lisp_Object map_parent
, parent_entry
;
364 /* SUBMAP is a cons that we found as a key binding.
365 Discard the other things found in a menu key binding. */
368 && STRINGP (XCONS (submap
)->car
))
370 submap
= XCONS (submap
)->cdr
;
371 /* Also remove a menu help string, if any,
372 following the menu item name. */
373 if (CONSP (submap
) && STRINGP (XCONS (submap
)->car
))
374 submap
= XCONS (submap
)->cdr
;
375 /* Also remove the sublist that caches key equivalences, if any. */
377 && CONSP (XCONS (submap
)->car
))
380 carcar
= XCONS (XCONS (submap
)->car
)->car
;
381 if (NILP (carcar
) || VECTORP (carcar
))
382 submap
= XCONS (submap
)->cdr
;
386 /* If it isn't a keymap now, there's no work to do. */
388 || ! EQ (XCONS (submap
)->car
, Qkeymap
))
391 map_parent
= Fkeymap_parent (map
);
392 if (! NILP (map_parent
))
393 parent_entry
= access_keymap (map_parent
, event
, 0, 0);
397 /* If MAP's parent has something other than a keymap,
398 our own submap shadows it completely, so use nil as SUBMAP's parent. */
399 if (! (CONSP (parent_entry
) && EQ (XCONS (parent_entry
)->car
, Qkeymap
)))
402 if (! EQ (parent_entry
, submap
))
403 Fset_keymap_parent (submap
, parent_entry
);
406 /* Look up IDX in MAP. IDX may be any sort of event.
407 Note that this does only one level of lookup; IDX must be a single
408 event, not a sequence.
410 If T_OK is non-zero, bindings for Qt are treated as default
411 bindings; any key left unmentioned by other tables and bindings is
412 given the binding of Qt.
414 If T_OK is zero, bindings for Qt are not treated specially.
416 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
419 access_keymap (map
, idx
, t_ok
, noinherit
)
428 /* If idx is a list (some sort of mouse click, perhaps?),
429 the index we want to use is the car of the list, which
430 ought to be a symbol. */
431 idx
= EVENT_HEAD (idx
);
433 /* If idx is a symbol, it might have modifiers, which need to
434 be put in the canonical order. */
436 idx
= reorder_modifiers (idx
);
437 else if (INTEGERP (idx
))
438 /* Clobber the high bits that can be present on a machine
439 with more than 24 bits of integer. */
440 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
444 Lisp_Object t_binding
;
447 for (tail
= map
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
451 binding
= XCONS (tail
)->car
;
452 if (SYMBOLP (binding
))
454 /* If NOINHERIT, stop finding prefix definitions
455 after we pass a second occurrence of the `keymap' symbol. */
456 if (noinherit
&& EQ (binding
, Qkeymap
) && ! EQ (tail
, map
))
459 else if (CONSP (binding
))
461 if (EQ (XCONS (binding
)->car
, idx
))
463 val
= XCONS (binding
)->cdr
;
464 if (noprefix
&& CONSP (val
) && EQ (XCONS (val
)->car
, Qkeymap
))
467 fix_submap_inheritance (map
, idx
, val
);
470 if (t_ok
&& EQ (XCONS (binding
)->car
, Qt
))
471 t_binding
= XCONS (binding
)->cdr
;
473 else if (VECTORP (binding
))
475 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (binding
)->size
)
477 val
= XVECTOR (binding
)->contents
[XFASTINT (idx
)];
478 if (noprefix
&& CONSP (val
) && EQ (XCONS (val
)->car
, Qkeymap
))
481 fix_submap_inheritance (map
, idx
, val
);
485 else if (CHAR_TABLE_P (binding
))
489 val
= Faref (binding
, idx
);
490 if (noprefix
&& CONSP (val
) && EQ (XCONS (val
)->car
, Qkeymap
))
493 fix_submap_inheritance (map
, idx
, val
);
505 /* Given OBJECT which was found in a slot in a keymap,
506 trace indirect definitions to get the actual definition of that slot.
507 An indirect definition is a list of the form
508 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
509 and INDEX is the object to look up in KEYMAP to yield the definition.
511 Also if OBJECT has a menu string as the first element,
512 remove that. Also remove a menu help string as second element.
514 If AUTOLOAD is nonzero, load autoloadable keymaps
515 that are referred to with indirection. */
518 get_keyelt (object
, autoload
)
519 register Lisp_Object object
;
524 register Lisp_Object map
, tem
;
526 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
527 map
= get_keymap_1 (Fcar_safe (object
), 0, autoload
);
528 tem
= Fkeymapp (map
);
533 if (INTEGERP (key
) && (XINT (key
) & meta_modifier
))
535 object
= access_keymap (map
, make_number (meta_prefix_char
),
537 map
= get_keymap_1 (object
, 0, autoload
);
538 object
= access_keymap (map
,
539 make_number (XINT (key
) & ~meta_modifier
),
543 object
= access_keymap (map
, key
, 0, 0);
546 /* If the keymap contents looks like (STRING . DEFN),
548 Keymap alist elements like (CHAR MENUSTRING . DEFN)
549 will be used by HierarKey menus. */
550 else if (CONSP (object
)
551 && STRINGP (XCONS (object
)->car
))
553 object
= XCONS (object
)->cdr
;
554 /* Also remove a menu help string, if any,
555 following the menu item name. */
556 if (CONSP (object
) && STRINGP (XCONS (object
)->car
))
557 object
= XCONS (object
)->cdr
;
558 /* Also remove the sublist that caches key equivalences, if any. */
560 && CONSP (XCONS (object
)->car
))
563 carcar
= XCONS (XCONS (object
)->car
)->car
;
564 if (NILP (carcar
) || VECTORP (carcar
))
565 object
= XCONS (object
)->cdr
;
570 /* Anything else is really the value. */
576 store_in_keymap (keymap
, idx
, def
)
578 register Lisp_Object idx
;
579 register Lisp_Object def
;
581 /* If we are preparing to dump, and DEF is a menu element
582 with a menu item string, copy it to ensure it is not pure. */
583 if (CONSP (def
) && PURE_P (def
) && STRINGP (XCONS (def
)->car
))
584 def
= Fcons (XCONS (def
)->car
, XCONS (def
)->cdr
);
586 if (!CONSP (keymap
) || ! EQ (XCONS (keymap
)->car
, Qkeymap
))
587 error ("attempt to define a key in a non-keymap");
589 /* If idx is a list (some sort of mouse click, perhaps?),
590 the index we want to use is the car of the list, which
591 ought to be a symbol. */
592 idx
= EVENT_HEAD (idx
);
594 /* If idx is a symbol, it might have modifiers, which need to
595 be put in the canonical order. */
597 idx
= reorder_modifiers (idx
);
598 else if (INTEGERP (idx
))
599 /* Clobber the high bits that can be present on a machine
600 with more than 24 bits of integer. */
601 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
603 /* Scan the keymap for a binding of idx. */
607 /* The cons after which we should insert new bindings. If the
608 keymap has a table element, we record its position here, so new
609 bindings will go after it; this way, the table will stay
610 towards the front of the alist and character lookups in dense
611 keymaps will remain fast. Otherwise, this just points at the
612 front of the keymap. */
613 Lisp_Object insertion_point
;
615 insertion_point
= keymap
;
616 for (tail
= XCONS (keymap
)->cdr
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
620 elt
= XCONS (tail
)->car
;
623 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (elt
)->size
)
625 XVECTOR (elt
)->contents
[XFASTINT (idx
)] = def
;
628 insertion_point
= tail
;
630 else if (CHAR_TABLE_P (elt
))
634 Faset (elt
, idx
, def
);
637 insertion_point
= tail
;
639 else if (CONSP (elt
))
641 if (EQ (idx
, XCONS (elt
)->car
))
643 XCONS (elt
)->cdr
= def
;
647 else if (SYMBOLP (elt
))
649 /* If we find a 'keymap' symbol in the spine of KEYMAP,
650 then we must have found the start of a second keymap
651 being used as the tail of KEYMAP, and a binding for IDX
652 should be inserted before it. */
653 if (EQ (elt
, Qkeymap
))
661 /* We have scanned the entire keymap, and not found a binding for
662 IDX. Let's add one. */
663 XCONS (insertion_point
)->cdr
664 = Fcons (Fcons (idx
, def
), XCONS (insertion_point
)->cdr
);
671 copy_keymap_1 (chartable
, idx
, elt
)
672 Lisp_Object chartable
, idx
, elt
;
674 if (!SYMBOLP (elt
) && ! NILP (Fkeymapp (elt
)))
675 Faset (chartable
, idx
, Fcopy_keymap (elt
));
678 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
679 "Return a copy of the keymap KEYMAP.\n\
680 The copy starts out with the same definitions of KEYMAP,\n\
681 but changing either the copy or KEYMAP does not affect the other.\n\
682 Any key definitions that are subkeymaps are recursively copied.\n\
683 However, a key definition which is a symbol whose definition is a keymap\n\
688 register Lisp_Object copy
, tail
;
690 copy
= Fcopy_alist (get_keymap (keymap
));
692 for (tail
= copy
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
696 elt
= XCONS (tail
)->car
;
697 if (CHAR_TABLE_P (elt
))
700 = (Lisp_Object
*) alloca (3 * sizeof (Lisp_Object
));
702 elt
= Fcopy_sequence (elt
);
703 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, 0, indices
);
705 else if (VECTORP (elt
))
709 elt
= Fcopy_sequence (elt
);
710 XCONS (tail
)->car
= elt
;
712 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
713 if (!SYMBOLP (XVECTOR (elt
)->contents
[i
])
714 && ! NILP (Fkeymapp (XVECTOR (elt
)->contents
[i
])))
715 XVECTOR (elt
)->contents
[i
]
716 = Fcopy_keymap (XVECTOR (elt
)->contents
[i
]);
718 else if (CONSP (elt
))
720 /* Skip the optional menu string. */
721 if (CONSP (XCONS (elt
)->cdr
)
722 && STRINGP (XCONS (XCONS (elt
)->cdr
)->car
))
726 /* Copy the cell, since copy-alist didn't go this deep. */
727 XCONS (elt
)->cdr
= Fcons (XCONS (XCONS (elt
)->cdr
)->car
,
728 XCONS (XCONS (elt
)->cdr
)->cdr
);
729 elt
= XCONS (elt
)->cdr
;
731 /* Also skip the optional menu help string. */
732 if (CONSP (XCONS (elt
)->cdr
)
733 && STRINGP (XCONS (XCONS (elt
)->cdr
)->car
))
735 XCONS (elt
)->cdr
= Fcons (XCONS (XCONS (elt
)->cdr
)->car
,
736 XCONS (XCONS (elt
)->cdr
)->cdr
);
737 elt
= XCONS (elt
)->cdr
;
739 /* There may also be a list that caches key equivalences.
740 Just delete it for the new keymap. */
741 if (CONSP (XCONS (elt
)->cdr
)
742 && CONSP (XCONS (XCONS (elt
)->cdr
)->car
)
743 && (NILP (tem
= XCONS (XCONS (XCONS (elt
)->cdr
)->car
)->car
)
745 XCONS (elt
)->cdr
= XCONS (XCONS (elt
)->cdr
)->cdr
;
748 && ! SYMBOLP (XCONS (elt
)->cdr
)
749 && ! NILP (Fkeymapp (XCONS (elt
)->cdr
)))
750 XCONS (elt
)->cdr
= Fcopy_keymap (XCONS (elt
)->cdr
);
757 /* Simple Keymap mutators and accessors. */
759 /* GC is possible in this function if it autoloads a keymap. */
761 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
762 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
763 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
764 meaning a sequence of keystrokes and events.\n\
765 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
766 can be included if you use a vector.\n\
767 DEF is anything that can be a key's definition:\n\
768 nil (means key is undefined in this keymap),\n\
769 a command (a Lisp function suitable for interactive calling)\n\
770 a string (treated as a keyboard macro),\n\
771 a keymap (to define a prefix key),\n\
772 a symbol. When the key is looked up, the symbol will stand for its\n\
773 function definition, which should at that time be one of the above,\n\
774 or another symbol whose function definition is used, etc.\n\
775 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
776 (DEFN should be a valid definition in its own right),\n\
777 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
779 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
780 the front of KEYMAP.")
787 register Lisp_Object c
;
788 register Lisp_Object tem
;
789 register Lisp_Object cmd
;
793 struct gcpro gcpro1
, gcpro2
, gcpro3
;
795 keymap
= get_keymap_1 (keymap
, 1, 1);
797 if (!VECTORP (key
) && !STRINGP (key
))
798 key
= wrong_type_argument (Qarrayp
, key
);
800 length
= XFASTINT (Flength (key
));
804 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
805 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
807 GCPRO3 (keymap
, key
, def
);
810 meta_bit
= meta_modifier
;
817 c
= Faref (key
, make_number (idx
));
819 if (CONSP (c
) && lucid_event_type_list_p (c
))
820 c
= Fevent_convert_list (c
);
823 && (XINT (c
) & meta_bit
)
826 c
= meta_prefix_char
;
832 XSETINT (c
, XINT (c
) & ~meta_bit
);
838 if (! INTEGERP (c
) && ! SYMBOLP (c
) && ! CONSP (c
))
839 error ("Key sequence contains invalid events");
842 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
844 cmd
= get_keyelt (access_keymap (keymap
, c
, 0, 1), 1);
846 /* If this key is undefined, make it a prefix. */
848 cmd
= define_as_prefix (keymap
, c
);
850 keymap
= get_keymap_1 (cmd
, 0, 1);
852 /* We must use Fkey_description rather than just passing key to
853 error; key might be a vector, not a string. */
854 error ("Key sequence %s uses invalid prefix characters",
855 XSTRING (Fkey_description (key
))->data
);
859 /* Value is number if KEY is too long; NIL if valid but has no definition. */
860 /* GC is possible in this function if it autoloads a keymap. */
862 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
863 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
864 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
866 A number as value means KEY is \"too long\";\n\
867 that is, characters or symbols in it except for the last one\n\
868 fail to be a valid sequence of prefix characters in KEYMAP.\n\
869 The number is how many characters at the front of KEY\n\
870 it takes to reach a non-prefix command.\n\
872 Normally, `lookup-key' ignores bindings for t, which act as default\n\
873 bindings, used when nothing else in the keymap applies; this makes it\n\
874 usable as a general function for probing keymaps. However, if the\n\
875 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
876 recognize the default bindings, just as `read-key-sequence' does.")
877 (keymap
, key
, accept_default
)
878 register Lisp_Object keymap
;
880 Lisp_Object accept_default
;
883 register Lisp_Object tem
;
884 register Lisp_Object cmd
;
885 register Lisp_Object c
;
888 int t_ok
= ! NILP (accept_default
);
892 keymap
= get_keymap_1 (keymap
, 1, 1);
894 if (!VECTORP (key
) && !STRINGP (key
))
895 key
= wrong_type_argument (Qarrayp
, key
);
897 length
= XFASTINT (Flength (key
));
902 meta_bit
= meta_modifier
;
911 c
= Faref (key
, make_number (idx
));
913 if (CONSP (c
) && lucid_event_type_list_p (c
))
914 c
= Fevent_convert_list (c
);
917 && (XINT (c
) & meta_bit
)
920 c
= meta_prefix_char
;
926 XSETINT (c
, XINT (c
) & ~meta_bit
);
932 cmd
= get_keyelt (access_keymap (keymap
, c
, t_ok
, 0), 1);
934 RETURN_UNGCPRO (cmd
);
936 keymap
= get_keymap_1 (cmd
, 0, 1);
938 RETURN_UNGCPRO (make_number (idx
));
944 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
945 Assume that currently it does not define C at all.
946 Return the keymap. */
949 define_as_prefix (keymap
, c
)
950 Lisp_Object keymap
, c
;
952 Lisp_Object inherit
, cmd
;
954 cmd
= Fmake_sparse_keymap (Qnil
);
955 /* If this key is defined as a prefix in an inherited keymap,
956 make it a prefix in this map, and make its definition
957 inherit the other prefix definition. */
958 inherit
= access_keymap (keymap
, c
, 0, 0);
960 /* This code is needed to do the right thing in the following case:
961 keymap A inherits from B,
962 you define KEY as a prefix in A,
963 then later you define KEY as a prefix in B.
964 We want the old prefix definition in A to inherit from that in B.
965 It is hard to do that retroactively, so this code
966 creates the prefix in B right away.
968 But it turns out that this code causes problems immediately
969 when the prefix in A is defined: it causes B to define KEY
970 as a prefix with no subcommands.
972 So I took out this code. */
975 /* If there's an inherited keymap
976 and it doesn't define this key,
977 make it define this key. */
980 for (tail
= Fcdr (keymap
); CONSP (tail
); tail
= XCONS (tail
)->cdr
)
981 if (EQ (XCONS (tail
)->car
, Qkeymap
))
985 inherit
= define_as_prefix (tail
, c
);
989 cmd
= nconc2 (cmd
, inherit
);
990 store_in_keymap (keymap
, c
, cmd
);
995 /* Append a key to the end of a key sequence. We always make a vector. */
998 append_key (key_sequence
, key
)
999 Lisp_Object key_sequence
, key
;
1001 Lisp_Object args
[2];
1003 args
[0] = key_sequence
;
1005 args
[1] = Fcons (key
, Qnil
);
1006 return Fvconcat (2, args
);
1010 /* Global, local, and minor mode keymap stuff. */
1012 /* We can't put these variables inside current_minor_maps, since under
1013 some systems, static gets macro-defined to be the empty string.
1015 static Lisp_Object
*cmm_modes
, *cmm_maps
;
1016 static int cmm_size
;
1018 /* Error handler used in current_minor_maps. */
1020 current_minor_maps_error ()
1025 /* Store a pointer to an array of the keymaps of the currently active
1026 minor modes in *buf, and return the number of maps it contains.
1028 This function always returns a pointer to the same buffer, and may
1029 free or reallocate it, so if you want to keep it for a long time or
1030 hand it out to lisp code, copy it. This procedure will be called
1031 for every key sequence read, so the nice lispy approach (return a
1032 new assoclist, list, what have you) for each invocation would
1033 result in a lot of consing over time.
1035 If we used xrealloc/xmalloc and ran out of memory, they would throw
1036 back to the command loop, which would try to read a key sequence,
1037 which would call this function again, resulting in an infinite
1038 loop. Instead, we'll use realloc/malloc and silently truncate the
1039 list, let the key sequence be read, and hope some other piece of
1040 code signals the error. */
1042 current_minor_maps (modeptr
, mapptr
)
1043 Lisp_Object
**modeptr
, **mapptr
;
1046 Lisp_Object alist
, assoc
, var
, val
;
1048 for (alist
= Vminor_mode_map_alist
;
1050 alist
= XCONS (alist
)->cdr
)
1051 if ((assoc
= XCONS (alist
)->car
, CONSP (assoc
))
1052 && (var
= XCONS (assoc
)->car
, SYMBOLP (var
))
1053 && (val
= find_symbol_value (var
), ! EQ (val
, Qunbound
))
1060 Lisp_Object
*newmodes
, *newmaps
;
1067 = (Lisp_Object
*) realloc (cmm_modes
,
1068 cmm_size
* sizeof (Lisp_Object
));
1070 = (Lisp_Object
*) realloc (cmm_maps
,
1071 cmm_size
* sizeof (Lisp_Object
));
1079 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1081 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1085 if (newmaps
&& newmodes
)
1087 cmm_modes
= newmodes
;
1094 /* Get the keymap definition--or nil if it is not defined. */
1095 temp
= internal_condition_case_1 (Findirect_function
,
1097 Qerror
, current_minor_maps_error
);
1101 cmm_maps
[i
] = temp
;
1106 if (modeptr
) *modeptr
= cmm_modes
;
1107 if (mapptr
) *mapptr
= cmm_maps
;
1111 /* GC is possible in this function if it autoloads a keymap. */
1113 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 2, 0,
1114 "Return the binding for command KEY in current keymaps.\n\
1115 KEY is a string or vector, a sequence of keystrokes.\n\
1116 The binding is probably a symbol with a function definition.\n\
1118 Normally, `key-binding' ignores bindings for t, which act as default\n\
1119 bindings, used when nothing else in the keymap applies; this makes it\n\
1120 usable as a general function for probing keymaps. However, if the\n\
1121 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1122 recognize the default bindings, just as `read-key-sequence' does.")
1123 (key
, accept_default
)
1124 Lisp_Object key
, accept_default
;
1126 Lisp_Object
*maps
, value
;
1128 struct gcpro gcpro1
;
1132 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1134 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1135 key
, accept_default
);
1136 if (! NILP (value
) && !INTEGERP (value
))
1137 RETURN_UNGCPRO (value
);
1139 else if (!NILP (Voverriding_local_map
))
1141 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1142 if (! NILP (value
) && !INTEGERP (value
))
1143 RETURN_UNGCPRO (value
);
1149 nmaps
= current_minor_maps (0, &maps
);
1150 /* Note that all these maps are GCPRO'd
1151 in the places where we found them. */
1153 for (i
= 0; i
< nmaps
; i
++)
1154 if (! NILP (maps
[i
]))
1156 value
= Flookup_key (maps
[i
], key
, accept_default
);
1157 if (! NILP (value
) && !INTEGERP (value
))
1158 RETURN_UNGCPRO (value
);
1161 local
= get_local_map (PT
, current_buffer
);
1165 value
= Flookup_key (local
, key
, accept_default
);
1166 if (! NILP (value
) && !INTEGERP (value
))
1167 RETURN_UNGCPRO (value
);
1171 value
= Flookup_key (current_global_map
, key
, accept_default
);
1173 if (! NILP (value
) && !INTEGERP (value
))
1179 /* GC is possible in this function if it autoloads a keymap. */
1181 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1182 "Return the binding for command KEYS in current local keymap only.\n\
1183 KEYS is a string, a sequence of keystrokes.\n\
1184 The binding is probably a symbol with a function definition.\n\
1186 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1187 bindings; see the description of `lookup-key' for more details about this.")
1188 (keys
, accept_default
)
1189 Lisp_Object keys
, accept_default
;
1191 register Lisp_Object map
;
1192 map
= current_buffer
->keymap
;
1195 return Flookup_key (map
, keys
, accept_default
);
1198 /* GC is possible in this function if it autoloads a keymap. */
1200 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1201 "Return the binding for command KEYS in current global keymap only.\n\
1202 KEYS is a string, a sequence of keystrokes.\n\
1203 The binding is probably a symbol with a function definition.\n\
1204 This function's return values are the same as those of lookup-key\n\
1207 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1208 bindings; see the description of `lookup-key' for more details about this.")
1209 (keys
, accept_default
)
1210 Lisp_Object keys
, accept_default
;
1212 return Flookup_key (current_global_map
, keys
, accept_default
);
1215 /* GC is possible in this function if it autoloads a keymap. */
1217 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1218 "Find the visible minor mode bindings of KEY.\n\
1219 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1220 the symbol which names the minor mode binding KEY, and BINDING is\n\
1221 KEY's definition in that mode. In particular, if KEY has no\n\
1222 minor-mode bindings, return nil. If the first binding is a\n\
1223 non-prefix, all subsequent bindings will be omitted, since they would\n\
1224 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1225 that come after prefix bindings.\n\
1227 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1228 bindings; see the description of `lookup-key' for more details about this.")
1229 (key
, accept_default
)
1230 Lisp_Object key
, accept_default
;
1232 Lisp_Object
*modes
, *maps
;
1234 Lisp_Object binding
;
1236 struct gcpro gcpro1
, gcpro2
;
1238 nmaps
= current_minor_maps (&modes
, &maps
);
1239 /* Note that all these maps are GCPRO'd
1240 in the places where we found them. */
1243 GCPRO2 (key
, binding
);
1245 for (i
= j
= 0; i
< nmaps
; i
++)
1246 if (! NILP (maps
[i
])
1247 && ! NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1248 && !INTEGERP (binding
))
1250 if (! NILP (get_keymap (binding
)))
1251 maps
[j
++] = Fcons (modes
[i
], binding
);
1253 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1257 return Flist (j
, maps
);
1260 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 2, 0,
1261 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1262 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1263 If a second optional argument MAPVAR is given, the map is stored as\n\
1264 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1267 Lisp_Object command
, mapvar
;
1270 map
= Fmake_sparse_keymap (Qnil
);
1271 Ffset (command
, map
);
1275 Fset (command
, map
);
1279 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1280 "Select KEYMAP as the global keymap.")
1284 keymap
= get_keymap (keymap
);
1285 current_global_map
= keymap
;
1290 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1291 "Select KEYMAP as the local keymap.\n\
1292 If KEYMAP is nil, that means no local keymap.")
1297 keymap
= get_keymap (keymap
);
1299 current_buffer
->keymap
= keymap
;
1304 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1305 "Return current buffer's local keymap, or nil if it has none.")
1308 return current_buffer
->keymap
;
1311 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1312 "Return the current global keymap.")
1315 return current_global_map
;
1318 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1319 "Return a list of keymaps for the minor modes of the current buffer.")
1323 int nmaps
= current_minor_maps (0, &maps
);
1325 return Flist (nmaps
, maps
);
1328 /* Help functions for describing and documenting keymaps. */
1330 static Lisp_Object
accessible_keymaps_char_table ();
1332 /* This function cannot GC. */
1334 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1336 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1337 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1338 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1339 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1340 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1341 then the value includes only maps for prefixes that start with PREFIX.")
1343 Lisp_Object keymap
, prefix
;
1345 Lisp_Object maps
, good_maps
, tail
;
1348 /* no need for gcpro because we don't autoload any keymaps. */
1351 prefixlen
= XINT (Flength (prefix
));
1355 /* If a prefix was specified, start with the keymap (if any) for
1356 that prefix, so we don't waste time considering other prefixes. */
1358 tem
= Flookup_key (keymap
, prefix
, Qt
);
1359 /* Flookup_key may give us nil, or a number,
1360 if the prefix is not defined in this particular map.
1361 It might even give us a list that isn't a keymap. */
1362 tem
= get_keymap_1 (tem
, 0, 0);
1365 /* Convert PREFIX to a vector now, so that later on
1366 we don't have to deal with the possibility of a string. */
1367 if (STRINGP (prefix
))
1372 copy
= Fmake_vector (make_number (XSTRING (prefix
)->size
), Qnil
);
1373 for (i
= 0; i
< XSTRING (prefix
)->size
; i
++)
1375 int c
= XSTRING (prefix
)->data
[i
];
1377 c
^= 0200 | meta_modifier
;
1378 XVECTOR (copy
)->contents
[i
] = make_number (c
);
1382 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1388 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1389 get_keymap (keymap
)),
1392 /* For each map in the list maps,
1393 look at any other maps it points to,
1394 and stick them at the end if they are not already in the list.
1396 This is a breadth-first traversal, where tail is the queue of
1397 nodes, and maps accumulates a list of all nodes visited. */
1399 for (tail
= maps
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1401 register Lisp_Object thisseq
, thismap
;
1403 /* Does the current sequence end in the meta-prefix-char? */
1406 thisseq
= Fcar (Fcar (tail
));
1407 thismap
= Fcdr (Fcar (tail
));
1408 last
= make_number (XINT (Flength (thisseq
)) - 1);
1409 is_metized
= (XINT (last
) >= 0
1410 /* Don't metize the last char of PREFIX. */
1411 && XINT (last
) >= prefixlen
1412 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1414 for (; CONSP (thismap
); thismap
= XCONS (thismap
)->cdr
)
1418 elt
= XCONS (thismap
)->car
;
1422 if (CHAR_TABLE_P (elt
))
1424 Lisp_Object
*indices
1425 = (Lisp_Object
*) alloca (3 * sizeof (Lisp_Object
));
1427 map_char_table (accessible_keymaps_char_table
, Qnil
,
1428 elt
, Fcons (maps
, Fcons (tail
, thisseq
)),
1431 else if (VECTORP (elt
))
1435 /* Vector keymap. Scan all the elements. */
1436 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
1438 register Lisp_Object tem
;
1439 register Lisp_Object cmd
;
1441 cmd
= get_keyelt (XVECTOR (elt
)->contents
[i
], 0);
1442 if (NILP (cmd
)) continue;
1443 tem
= Fkeymapp (cmd
);
1446 cmd
= get_keymap (cmd
);
1447 /* Ignore keymaps that are already added to maps. */
1448 tem
= Frassq (cmd
, maps
);
1451 /* If the last key in thisseq is meta-prefix-char,
1452 turn it into a meta-ized keystroke. We know
1453 that the event we're about to append is an
1454 ascii keystroke since we're processing a
1458 int meta_bit
= meta_modifier
;
1459 tem
= Fcopy_sequence (thisseq
);
1461 Faset (tem
, last
, make_number (i
| meta_bit
));
1463 /* This new sequence is the same length as
1464 thisseq, so stick it in the list right
1467 = Fcons (Fcons (tem
, cmd
), XCONS (tail
)->cdr
);
1471 tem
= append_key (thisseq
, make_number (i
));
1472 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1478 else if (CONSP (elt
))
1480 register Lisp_Object cmd
, tem
, filter
;
1482 cmd
= get_keyelt (XCONS (elt
)->cdr
, 0);
1483 /* Ignore definitions that aren't keymaps themselves. */
1484 tem
= Fkeymapp (cmd
);
1487 /* Ignore keymaps that have been seen already. */
1488 cmd
= get_keymap (cmd
);
1489 tem
= Frassq (cmd
, maps
);
1492 /* Let elt be the event defined by this map entry. */
1493 elt
= XCONS (elt
)->car
;
1495 /* If the last key in thisseq is meta-prefix-char, and
1496 this entry is a binding for an ascii keystroke,
1497 turn it into a meta-ized keystroke. */
1498 if (is_metized
&& INTEGERP (elt
))
1500 Lisp_Object element
;
1503 tem
= Fvconcat (1, &element
);
1504 XVECTOR (tem
)->contents
[XINT (last
)]
1505 = XINT (elt
) | meta_modifier
;
1507 /* This new sequence is the same length as
1508 thisseq, so stick it in the list right
1511 = Fcons (Fcons (tem
, cmd
), XCONS (tail
)->cdr
);
1515 Fcons (Fcons (append_key (thisseq
, elt
), cmd
),
1526 /* Now find just the maps whose access prefixes start with PREFIX. */
1529 for (; CONSP (maps
); maps
= XCONS (maps
)->cdr
)
1531 Lisp_Object elt
, thisseq
;
1532 elt
= XCONS (maps
)->car
;
1533 thisseq
= XCONS (elt
)->car
;
1534 /* The access prefix must be at least as long as PREFIX,
1535 and the first elements must match those of PREFIX. */
1536 if (XINT (Flength (thisseq
)) >= prefixlen
)
1539 for (i
= 0; i
< prefixlen
; i
++)
1542 XSETFASTINT (i1
, i
);
1543 if (!EQ (Faref (thisseq
, i1
), Faref (prefix
, i1
)))
1547 good_maps
= Fcons (elt
, good_maps
);
1551 return Fnreverse (good_maps
);
1555 accessible_keymaps_char_table (args
, index
, cmd
)
1556 Lisp_Object args
, index
, cmd
;
1559 Lisp_Object maps
, tail
, thisseq
;
1564 maps
= XCONS (args
)->car
;
1565 tail
= XCONS (XCONS (args
)->cdr
)->car
;
1566 thisseq
= XCONS (XCONS (args
)->cdr
)->cdr
;
1568 tem
= Fkeymapp (cmd
);
1571 cmd
= get_keymap (cmd
);
1572 /* Ignore keymaps that are already added to maps. */
1573 tem
= Frassq (cmd
, maps
);
1576 tem
= append_key (thisseq
, index
);
1577 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1583 Lisp_Object Qsingle_key_description
, Qkey_description
;
1585 /* This function cannot GC. */
1587 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1588 "Return a pretty description of key-sequence KEYS.\n\
1589 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1590 spaces are put between sequence elements, etc.")
1602 vector
= Fmake_vector (Flength (keys
), Qnil
);
1603 for (i
= 0; i
< XSTRING (keys
)->size
; i
++)
1605 if (XSTRING (keys
)->data
[i
] & 0x80)
1606 XSETFASTINT (XVECTOR (vector
)->contents
[i
],
1607 meta_modifier
| (XSTRING (keys
)->data
[i
] & ~0x80));
1609 XSETFASTINT (XVECTOR (vector
)->contents
[i
],
1610 XSTRING (keys
)->data
[i
]);
1614 else if (!VECTORP (keys
))
1615 keys
= wrong_type_argument (Qarrayp
, keys
);
1617 /* In effect, this computes
1618 (mapconcat 'single-key-description keys " ")
1619 but we shouldn't use mapconcat because it can do GC. */
1621 len
= XVECTOR (keys
)->size
;
1622 sep
= build_string (" ");
1623 /* This has one extra element at the end that we don't pass to Fconcat. */
1624 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1626 for (i
= 0; i
< len
; i
++)
1628 args
[i
* 2] = Fsingle_key_description (XVECTOR (keys
)->contents
[i
]);
1629 args
[i
* 2 + 1] = sep
;
1632 return Fconcat (len
* 2 - 1, args
);
1636 push_key_description (c
, p
)
1637 register unsigned int c
;
1640 /* Clear all the meaningless bits above the meta bit. */
1641 c
&= meta_modifier
| ~ - meta_modifier
;
1643 if (c
& alt_modifier
)
1649 if (c
& ctrl_modifier
)
1655 if (c
& hyper_modifier
)
1659 c
-= hyper_modifier
;
1661 if (c
& meta_modifier
)
1667 if (c
& shift_modifier
)
1671 c
-= shift_modifier
;
1673 if (c
& super_modifier
)
1677 c
-= super_modifier
;
1693 else if (c
== Ctl ('M'))
1703 if (c
> 0 && c
<= Ctl ('Z'))
1728 *p
++ = (7 & (c
>> 6)) + '0';
1729 *p
++ = (7 & (c
>> 3)) + '0';
1730 *p
++ = (7 & (c
>> 0)) + '0';
1735 *p
++ = (7 & (c
>> 15)) + '0';
1736 *p
++ = (7 & (c
>> 12)) + '0';
1737 *p
++ = (7 & (c
>> 9)) + '0';
1738 *p
++ = (7 & (c
>> 6)) + '0';
1739 *p
++ = (7 & (c
>> 3)) + '0';
1740 *p
++ = (7 & (c
>> 0)) + '0';
1746 /* This function cannot GC. */
1748 DEFUN ("single-key-description", Fsingle_key_description
, Ssingle_key_description
, 1, 1, 0,
1749 "Return a pretty description of command character KEY.\n\
1750 Control characters turn into C-whatever, etc.")
1756 key
= EVENT_HEAD (key
);
1758 if (INTEGERP (key
)) /* Normal character */
1760 *push_key_description (XUINT (key
), tem
) = 0;
1761 return build_string (tem
);
1763 else if (SYMBOLP (key
)) /* Function key or event-symbol */
1764 return Fsymbol_name (key
);
1765 else if (STRINGP (key
)) /* Buffer names in the menubar. */
1766 return Fcopy_sequence (key
);
1768 error ("KEY must be an integer, cons, symbol, or string");
1772 push_text_char_description (c
, p
)
1773 register unsigned int c
;
1785 *p
++ = c
+ 64; /* 'A' - 1 */
1797 /* This function cannot GC. */
1799 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
1800 "Return a pretty description of file-character CHARACTER.\n\
1801 Control characters turn into \"^char\", etc.")
1803 Lisp_Object character
;
1807 CHECK_NUMBER (character
, 0);
1809 if (!SINGLE_BYTE_CHAR_P (XFASTINT (character
)))
1812 int len
= non_ascii_char_to_string (XFASTINT (character
), tem
, &str
);
1814 return make_string (str
, len
);
1817 *push_text_char_description (XINT (character
) & 0377, tem
) = 0;
1819 return build_string (tem
);
1822 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1825 ascii_sequence_p (seq
)
1829 int len
= XINT (Flength (seq
));
1831 for (i
= 0; i
< len
; i
++)
1833 Lisp_Object ii
, elt
;
1835 XSETFASTINT (ii
, i
);
1836 elt
= Faref (seq
, ii
);
1839 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
1847 /* where-is - finding a command in a set of keymaps. */
1849 static Lisp_Object
where_is_internal_1 ();
1850 static Lisp_Object
where_is_internal_2 ();
1852 /* This function can GC if Flookup_key autoloads any keymaps. */
1854 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 4, 0,
1855 "Return list of keys that invoke DEFINITION.\n\
1856 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1857 If KEYMAP is nil, search all the currently active keymaps.\n\
1859 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1860 rather than a list of all possible key sequences.\n\
1861 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
1862 no matter what it is.\n\
1863 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
1864 and entirely reject menu bindings.\n\
1866 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
1867 to other keymaps or slots. This makes it possible to search for an\n\
1868 indirect definition itself.")
1869 (definition
, keymap
, firstonly
, noindirect
)
1870 Lisp_Object definition
, keymap
;
1871 Lisp_Object firstonly
, noindirect
;
1874 Lisp_Object found
, sequences
;
1875 int keymap_specified
= !NILP (keymap
);
1876 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1877 /* 1 means ignore all menu bindings entirely. */
1878 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
1880 if (! keymap_specified
)
1882 #ifdef USE_TEXT_PROPERTIES
1883 keymap
= get_local_map (PT
, current_buffer
);
1885 keymap
= current_buffer
->keymap
;
1890 maps
= nconc2 (Faccessible_keymaps (get_keymap (keymap
), Qnil
),
1891 Faccessible_keymaps (get_keymap (current_global_map
),
1894 maps
= Faccessible_keymaps (get_keymap (current_global_map
), Qnil
);
1896 /* Put the minor mode keymaps on the front. */
1897 if (! keymap_specified
)
1900 minors
= Fnreverse (Fcurrent_minor_mode_maps ());
1901 while (!NILP (minors
))
1903 maps
= nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors
)->car
),
1906 minors
= XCONS (minors
)->cdr
;
1910 GCPRO5 (definition
, keymap
, maps
, found
, sequences
);
1914 for (; !NILP (maps
); maps
= Fcdr (maps
))
1916 /* Key sequence to reach map, and the map that it reaches */
1917 register Lisp_Object
this, map
;
1919 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1920 [M-CHAR] sequences, check if last character of the sequence
1921 is the meta-prefix char. */
1925 this = Fcar (Fcar (maps
));
1926 map
= Fcdr (Fcar (maps
));
1927 last
= make_number (XINT (Flength (this)) - 1);
1928 last_is_meta
= (XINT (last
) >= 0
1929 && EQ (Faref (this, last
), meta_prefix_char
));
1935 /* Because the code we want to run on each binding is rather
1936 large, we don't want to have two separate loop bodies for
1937 sparse keymap bindings and tables; we want to iterate one
1938 loop body over both keymap and vector bindings.
1940 For this reason, if Fcar (map) is a vector, we don't
1941 advance map to the next element until i indicates that we
1942 have finished off the vector. */
1943 Lisp_Object elt
, key
, binding
;
1944 elt
= XCONS (map
)->car
;
1945 map
= XCONS (map
)->cdr
;
1951 /* Set key and binding to the current key and binding, and
1952 advance map and i to the next binding. */
1955 Lisp_Object sequence
;
1957 /* In a vector, look at each element. */
1958 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
1960 binding
= XVECTOR (elt
)->contents
[i
];
1961 XSETFASTINT (key
, i
);
1962 sequence
= where_is_internal_1 (binding
, key
, definition
,
1963 noindirect
, keymap
, this,
1964 last
, nomenus
, last_is_meta
);
1965 if (!NILP (sequence
))
1966 sequences
= Fcons (sequence
, sequences
);
1969 else if (CHAR_TABLE_P (elt
))
1971 Lisp_Object
*indices
1972 = (Lisp_Object
*) alloca (3 * sizeof (Lisp_Object
));
1974 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
1975 Fcons (keymap
, Qnil
)),
1976 Fcons (Fcons (this, last
),
1977 Fcons (make_number (nomenus
),
1978 make_number (last_is_meta
))));
1980 map_char_table (where_is_internal_2
, Qnil
, elt
, args
,
1982 sequences
= XCONS (XCONS (XCONS (args
)->car
)->cdr
)->cdr
;
1984 else if (CONSP (elt
))
1986 Lisp_Object sequence
;
1988 key
= XCONS (elt
)->car
;
1989 binding
= XCONS (elt
)->cdr
;
1991 sequence
= where_is_internal_1 (binding
, key
, definition
,
1992 noindirect
, keymap
, this,
1993 last
, nomenus
, last_is_meta
);
1994 if (!NILP (sequence
))
1995 sequences
= Fcons (sequence
, sequences
);
1999 for (; ! NILP (sequences
); sequences
= XCONS (sequences
)->cdr
)
2001 Lisp_Object sequence
;
2003 sequence
= XCONS (sequences
)->car
;
2005 /* It is a true unshadowed match. Record it, unless it's already
2006 been seen (as could happen when inheriting keymaps). */
2007 if (NILP (Fmember (sequence
, found
)))
2008 found
= Fcons (sequence
, found
);
2010 /* If firstonly is Qnon_ascii, then we can return the first
2011 binding we find. If firstonly is not Qnon_ascii but not
2012 nil, then we should return the first ascii-only binding
2014 if (EQ (firstonly
, Qnon_ascii
))
2015 RETURN_UNGCPRO (sequence
);
2016 else if (! NILP (firstonly
) && ascii_sequence_p (sequence
))
2017 RETURN_UNGCPRO (sequence
);
2024 found
= Fnreverse (found
);
2026 /* firstonly may have been t, but we may have gone all the way through
2027 the keymaps without finding an all-ASCII key sequence. So just
2028 return the best we could find. */
2029 if (! NILP (firstonly
))
2030 return Fcar (found
);
2035 /* This is the function that Fwhere_is_internal calls using map_char_table.
2037 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2039 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2040 Since map_char_table doesn't really use the return value from this function,
2041 we the result append to RESULT, the slot in ARGS. */
2044 where_is_internal_2 (args
, key
, binding
)
2045 Lisp_Object args
, key
, binding
;
2047 Lisp_Object definition
, noindirect
, keymap
, this, last
;
2048 Lisp_Object result
, sequence
;
2049 int nomenus
, last_is_meta
;
2051 result
= XCONS (XCONS (XCONS (args
)->car
)->cdr
)->cdr
;
2052 definition
= XCONS (XCONS (XCONS (args
)->car
)->car
)->car
;
2053 noindirect
= XCONS (XCONS (XCONS (args
)->car
)->car
)->cdr
;
2054 keymap
= XCONS (XCONS (XCONS (args
)->car
)->cdr
)->car
;
2055 this = XCONS (XCONS (XCONS (args
)->cdr
)->car
)->car
;
2056 last
= XCONS (XCONS (XCONS (args
)->cdr
)->car
)->cdr
;
2057 nomenus
= XFASTINT (XCONS (XCONS (XCONS (args
)->cdr
)->cdr
)->car
);
2058 last_is_meta
= XFASTINT (XCONS (XCONS (XCONS (args
)->cdr
)->cdr
)->cdr
);
2060 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
,
2061 this, last
, nomenus
, last_is_meta
);
2063 if (!NILP (sequence
))
2064 XCONS (XCONS (XCONS (args
)->car
)->cdr
)->cdr
2065 = Fcons (sequence
, result
);
2071 where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
, this, last
,
2072 nomenus
, last_is_meta
)
2073 Lisp_Object binding
, key
, definition
, noindirect
, keymap
, this, last
;
2074 int nomenus
, last_is_meta
;
2076 Lisp_Object sequence
;
2077 int keymap_specified
= !NILP (keymap
);
2079 /* Search through indirections unless that's not wanted. */
2080 if (NILP (noindirect
))
2086 Lisp_Object map
, tem
;
2087 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2088 map
= get_keymap_1 (Fcar_safe (definition
), 0, 0);
2089 tem
= Fkeymapp (map
);
2091 definition
= access_keymap (map
, Fcdr (definition
), 0, 0);
2095 /* If the contents are (STRING ...), reject. */
2096 if (CONSP (definition
)
2097 && STRINGP (XCONS (definition
)->car
))
2101 binding
= get_keyelt (binding
, 0);
2104 /* End this iteration if this element does not match
2107 if (CONSP (definition
))
2110 tem
= Fequal (binding
, definition
);
2115 if (!EQ (binding
, definition
))
2118 /* We have found a match.
2119 Construct the key sequence where we found it. */
2120 if (INTEGERP (key
) && last_is_meta
)
2122 sequence
= Fcopy_sequence (this);
2123 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2126 sequence
= append_key (this, key
);
2128 /* Verify that this key binding is not shadowed by another
2129 binding for the same key, before we say it exists.
2131 Mechanism: look for local definition of this key and if
2132 it is defined and does not match what we found then
2135 Either nil or number as value from Flookup_key
2137 if (keymap_specified
)
2139 binding
= Flookup_key (keymap
, sequence
, Qnil
);
2140 if (!NILP (binding
) && !INTEGERP (binding
))
2142 if (CONSP (definition
))
2145 tem
= Fequal (binding
, definition
);
2150 if (!EQ (binding
, definition
))
2156 binding
= Fkey_binding (sequence
, Qnil
);
2157 if (!EQ (binding
, definition
))
2164 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2166 DEFUN ("describe-bindings", Fdescribe_bindings
, Sdescribe_bindings
, 0, 1, "",
2167 "Show a list of all defined keys, and their definitions.\n\
2168 The list is put in a buffer, which is displayed.\n\
2169 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
2170 then we display only bindings that start with that prefix.")
2174 register Lisp_Object thisbuf
;
2175 XSETBUFFER (thisbuf
, current_buffer
);
2176 internal_with_output_to_temp_buffer ("*Help*",
2177 describe_buffer_bindings
,
2178 Fcons (thisbuf
, prefix
));
2182 /* ARG is (BUFFER . PREFIX). */
2185 describe_buffer_bindings (arg
)
2188 Lisp_Object descbuf
, prefix
, shadow
;
2189 register Lisp_Object start1
;
2190 struct gcpro gcpro1
;
2192 char *alternate_heading
2194 Alternate Characters (use anywhere the nominal character is listed):\n\
2195 nominal alternate\n\
2196 ------- ---------\n";
2198 descbuf
= XCONS (arg
)->car
;
2199 prefix
= XCONS (arg
)->cdr
;
2203 Fset_buffer (Vstandard_output
);
2205 /* Report on alternates for keys. */
2206 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2209 unsigned char *translate
= XSTRING (Vkeyboard_translate_table
)->data
;
2210 int translate_len
= XSTRING (Vkeyboard_translate_table
)->size
;
2212 for (c
= 0; c
< translate_len
; c
++)
2213 if (translate
[c
] != c
)
2218 if (alternate_heading
)
2220 insert_string (alternate_heading
);
2221 alternate_heading
= 0;
2224 bufend
= push_key_description (translate
[c
], buf
);
2225 insert (buf
, bufend
- buf
);
2226 Findent_to (make_number (16), make_number (1));
2227 bufend
= push_key_description (c
, buf
);
2228 insert (buf
, bufend
- buf
);
2236 if (!NILP (Vkey_translation_map
))
2237 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2238 "Key translations", 0, 1, 0);
2242 Lisp_Object
*modes
, *maps
;
2244 /* Temporarily switch to descbuf, so that we can get that buffer's
2245 minor modes correctly. */
2246 Fset_buffer (descbuf
);
2248 if (!NILP (current_kboard
->Voverriding_terminal_local_map
)
2249 || !NILP (Voverriding_local_map
))
2252 nmaps
= current_minor_maps (&modes
, &maps
);
2253 Fset_buffer (Vstandard_output
);
2255 /* Print the minor mode maps. */
2256 for (i
= 0; i
< nmaps
; i
++)
2258 /* The title for a minor mode keymap
2259 is constructed at run time.
2260 We let describe_map_tree do the actual insertion
2261 because it takes care of other features when doing so. */
2264 if (!SYMBOLP (modes
[i
]))
2267 p
= title
= (char *) alloca (40 + XSYMBOL (modes
[i
])->name
->size
);
2269 bcopy (XSYMBOL (modes
[i
])->name
->data
, p
,
2270 XSYMBOL (modes
[i
])->name
->size
);
2271 p
+= XSYMBOL (modes
[i
])->name
->size
;
2273 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2274 p
+= sizeof (" Minor Mode Bindings") - 1;
2277 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, 0, 0, 0);
2278 shadow
= Fcons (maps
[i
], shadow
);
2282 /* Print the (major mode) local map. */
2283 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2284 start1
= current_kboard
->Voverriding_terminal_local_map
;
2285 else if (!NILP (Voverriding_local_map
))
2286 start1
= Voverriding_local_map
;
2288 start1
= XBUFFER (descbuf
)->keymap
;
2292 describe_map_tree (start1
, 1, shadow
, prefix
,
2293 "Major Mode Bindings", 0, 0, 0);
2294 shadow
= Fcons (start1
, shadow
);
2297 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2298 "Global Bindings", 0, 0, 1);
2300 /* Print the function-key-map translations under this prefix. */
2301 if (!NILP (Vfunction_key_map
))
2302 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2303 "Function key map translations", 0, 1, 0);
2305 call0 (intern ("help-mode"));
2306 Fset_buffer (descbuf
);
2311 /* Insert a description of the key bindings in STARTMAP,
2312 followed by those of all maps reachable through STARTMAP.
2313 If PARTIAL is nonzero, omit certain "uninteresting" commands
2314 (such as `undefined').
2315 If SHADOW is non-nil, it is a list of maps;
2316 don't mention keys which would be shadowed by any of them.
2317 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2318 TITLE, if not 0, is a string to insert at the beginning.
2319 TITLE should not end with a colon or a newline; we supply that.
2320 If NOMENU is not 0, then omit menu-bar commands.
2322 If TRANSL is nonzero, the definitions are actually key translations
2323 so print strings and vectors differently.
2325 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2329 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2331 Lisp_Object startmap
, shadow
, prefix
;
2338 Lisp_Object maps
, seen
, sub_shadows
;
2339 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2346 maps
= Faccessible_keymaps (startmap
, prefix
);
2349 GCPRO3 (maps
, seen
, sub_shadows
);
2355 /* Delete from MAPS each element that is for the menu bar. */
2356 for (list
= maps
; !NILP (list
); list
= XCONS (list
)->cdr
)
2358 Lisp_Object elt
, prefix
, tem
;
2361 prefix
= Fcar (elt
);
2362 if (XVECTOR (prefix
)->size
>= 1)
2364 tem
= Faref (prefix
, make_number (0));
2365 if (EQ (tem
, Qmenu_bar
))
2366 maps
= Fdelq (elt
, maps
);
2371 if (!NILP (maps
) || always_title
)
2375 insert_string (title
);
2378 insert_string (" Starting With ");
2379 insert1 (Fkey_description (prefix
));
2381 insert_string (":\n");
2383 insert_string (key_heading
);
2387 for (; !NILP (maps
); maps
= Fcdr (maps
))
2389 register Lisp_Object elt
, prefix
, tail
;
2392 prefix
= Fcar (elt
);
2396 for (tail
= shadow
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
2400 shmap
= XCONS (tail
)->car
;
2402 /* If the sequence by which we reach this keymap is zero-length,
2403 then the shadow map for this keymap is just SHADOW. */
2404 if ((STRINGP (prefix
) && XSTRING (prefix
)->size
== 0)
2405 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2407 /* If the sequence by which we reach this keymap actually has
2408 some elements, then the sequence's definition in SHADOW is
2409 what we should use. */
2412 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2413 if (INTEGERP (shmap
))
2417 /* If shmap is not nil and not a keymap,
2418 it completely shadows this map, so don't
2419 describe this map at all. */
2420 if (!NILP (shmap
) && NILP (Fkeymapp (shmap
)))
2424 sub_shadows
= Fcons (shmap
, sub_shadows
);
2427 describe_map (Fcdr (elt
), Fcar (elt
),
2428 transl
? describe_translation
: describe_command
,
2429 partial
, sub_shadows
, &seen
, nomenu
);
2435 insert_string ("\n");
2440 static int previous_description_column
;
2443 describe_command (definition
)
2444 Lisp_Object definition
;
2446 register Lisp_Object tem1
;
2447 int column
= current_column ();
2448 int description_column
;
2450 /* If column 16 is no good, go to col 32;
2451 but don't push beyond that--go to next line instead. */
2455 description_column
= 32;
2457 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
2458 description_column
= 32;
2460 description_column
= 16;
2462 Findent_to (make_number (description_column
), make_number (1));
2463 previous_description_column
= description_column
;
2465 if (SYMBOLP (definition
))
2467 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2469 insert_string ("\n");
2471 else if (STRINGP (definition
) || VECTORP (definition
))
2472 insert_string ("Keyboard Macro\n");
2475 tem1
= Fkeymapp (definition
);
2477 insert_string ("Prefix Command\n");
2479 insert_string ("??\n");
2484 describe_translation (definition
)
2485 Lisp_Object definition
;
2487 register Lisp_Object tem1
;
2489 Findent_to (make_number (16), make_number (1));
2491 if (SYMBOLP (definition
))
2493 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2495 insert_string ("\n");
2497 else if (STRINGP (definition
) || VECTORP (definition
))
2499 insert1 (Fkey_description (definition
));
2500 insert_string ("\n");
2504 tem1
= Fkeymapp (definition
);
2506 insert_string ("Prefix Command\n");
2508 insert_string ("??\n");
2512 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2513 Returns the first non-nil binding found in any of those maps. */
2516 shadow_lookup (shadow
, key
, flag
)
2517 Lisp_Object shadow
, key
, flag
;
2519 Lisp_Object tail
, value
;
2521 for (tail
= shadow
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
2523 value
= Flookup_key (XCONS (tail
)->car
, key
, flag
);
2530 /* Describe the contents of map MAP, assuming that this map itself is
2531 reached by the sequence of prefix keys KEYS (a string or vector).
2532 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2535 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
2536 register Lisp_Object map
;
2538 int (*elt_describer
) ();
2544 Lisp_Object elt_prefix
;
2545 Lisp_Object tail
, definition
, event
;
2547 Lisp_Object suppress
;
2550 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2552 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
2554 /* Call Fkey_description first, to avoid GC bug for the other string. */
2555 tem
= Fkey_description (keys
);
2556 elt_prefix
= concat2 (tem
, build_string (" "));
2562 suppress
= intern ("suppress-keymap");
2564 /* This vector gets used to present single keys to Flookup_key. Since
2565 that is done once per keymap element, we don't want to cons up a
2566 fresh vector every time. */
2567 kludge
= Fmake_vector (make_number (1), Qnil
);
2570 GCPRO3 (elt_prefix
, definition
, kludge
);
2572 for (tail
= map
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
2576 if (VECTORP (XCONS (tail
)->car
)
2577 || CHAR_TABLE_P (XCONS (tail
)->car
))
2578 describe_vector (XCONS (tail
)->car
,
2579 elt_prefix
, elt_describer
, partial
, shadow
, map
,
2581 else if (CONSP (XCONS (tail
)->car
))
2583 event
= XCONS (XCONS (tail
)->car
)->car
;
2585 /* Ignore bindings whose "keys" are not really valid events.
2586 (We get these in the frames and buffers menu.) */
2587 if (! (SYMBOLP (event
) || INTEGERP (event
)))
2590 if (nomenu
&& EQ (event
, Qmenu_bar
))
2593 definition
= get_keyelt (XCONS (XCONS (tail
)->car
)->cdr
, 0);
2595 /* Don't show undefined commands or suppressed commands. */
2596 if (NILP (definition
)) continue;
2597 if (SYMBOLP (definition
) && partial
)
2599 tem
= Fget (definition
, suppress
);
2604 /* Don't show a command that isn't really visible
2605 because a local definition of the same key shadows it. */
2607 XVECTOR (kludge
)->contents
[0] = event
;
2610 tem
= shadow_lookup (shadow
, kludge
, Qt
);
2611 if (!NILP (tem
)) continue;
2614 tem
= Flookup_key (map
, kludge
, Qt
);
2615 if (! EQ (tem
, definition
)) continue;
2619 previous_description_column
= 0;
2624 if (!NILP (elt_prefix
))
2625 insert1 (elt_prefix
);
2627 /* THIS gets the string to describe the character EVENT. */
2628 insert1 (Fsingle_key_description (event
));
2630 /* Print a description of the definition of this character.
2631 elt_describer will take care of spacing out far enough
2632 for alignment purposes. */
2633 (*elt_describer
) (definition
);
2635 else if (EQ (XCONS (tail
)->car
, Qkeymap
))
2637 /* The same keymap might be in the structure twice, if we're
2638 using an inherited keymap. So skip anything we've already
2640 tem
= Fassq (tail
, *seen
);
2641 if (CONSP (tem
) && !NILP (Fequal (XCONS (tem
)->car
, keys
)))
2643 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
2651 describe_vector_princ (elt
)
2654 Findent_to (make_number (16), make_number (1));
2659 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 1, 0,
2660 "Insert a description of contents of VECTOR.\n\
2661 This is text showing the elements of vector matched against indices.")
2665 int count
= specpdl_ptr
- specpdl
;
2667 specbind (Qstandard_output
, Fcurrent_buffer ());
2668 CHECK_VECTOR_OR_CHAR_TABLE (vector
, 0);
2669 describe_vector (vector
, Qnil
, describe_vector_princ
, 0,
2670 Qnil
, Qnil
, (int *)0, 0);
2672 return unbind_to (count
, Qnil
);
2675 /* Insert in the current buffer a description of the contents of VECTOR.
2676 We call ELT_DESCRIBER to insert the description of one value found
2679 ELT_PREFIX describes what "comes before" the keys or indices defined
2680 by this vector. This is a human-readable string whose size
2681 is not necessarily related to the situation.
2683 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2684 leads to this keymap.
2686 If the vector is a chartable, ELT_PREFIX is the vector
2687 of bytes that lead to the character set or portion of a character
2688 set described by this chartable.
2690 If PARTIAL is nonzero, it means do not mention suppressed commands
2691 (that assumes the vector is in a keymap).
2693 SHADOW is a list of keymaps that shadow this map.
2694 If it is non-nil, then we look up the key in those maps
2695 and we don't mention it now if it is defined by any of them.
2697 ENTIRE_MAP is the keymap in which this vector appears.
2698 If the definition in effect in the whole map does not match
2699 the one in this vector, we ignore this one.
2701 When describing a sub-char-table, INDICES is a list of
2702 indices at higher levels in this char-table,
2703 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2705 describe_vector (vector
, elt_prefix
, elt_describer
,
2706 partial
, shadow
, entire_map
,
2707 indices
, char_table_depth
)
2708 register Lisp_Object vector
;
2709 Lisp_Object elt_prefix
;
2710 int (*elt_describer
) ();
2713 Lisp_Object entire_map
;
2715 int char_table_depth
;
2717 Lisp_Object definition
;
2720 Lisp_Object suppress
;
2723 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2724 /* Range of elements to be handled. */
2726 /* Flag to tell if we should handle multibyte characters. */
2727 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
2728 /* A flag to tell if a leaf in this level of char-table is not a
2729 generic character (i.e. a complete multibyte character). */
2735 indices
= (Lisp_Object
*) alloca (3 * sizeof (Lisp_Object
));
2739 /* This vector gets used to present single keys to Flookup_key. Since
2740 that is done once per vector element, we don't want to cons up a
2741 fresh vector every time. */
2742 kludge
= Fmake_vector (make_number (1), Qnil
);
2743 GCPRO3 (elt_prefix
, definition
, kludge
);
2746 suppress
= intern ("suppress-keymap");
2748 if (CHAR_TABLE_P (vector
))
2750 if (char_table_depth
== 0)
2752 /* VECTOR is a top level char-table. */
2755 to
= CHAR_TABLE_ORDINARY_SLOTS
;
2759 /* VECTOR is a sub char-table. */
2760 if (char_table_depth
>= 3)
2761 /* A char-table is never that deep. */
2762 error ("Too deep char table");
2765 = (CHARSET_VALID_P (indices
[0])
2766 && ((CHARSET_DIMENSION (indices
[0]) == 1
2767 && char_table_depth
== 1)
2768 || char_table_depth
== 2));
2770 /* Meaningful elements are from 32th to 127th. */
2772 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
2777 /* This does the right thing for ordinary vectors. */
2781 to
= XVECTOR (vector
)->size
;
2784 for (i
= from
; i
< to
; i
++)
2788 if (CHAR_TABLE_P (vector
))
2790 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
2793 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
2794 && !CHARSET_DEFINED_P (i
- 128))
2798 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
2801 definition
= get_keyelt (XVECTOR (vector
)->contents
[i
], 0);
2803 if (NILP (definition
)) continue;
2805 /* Don't mention suppressed commands. */
2806 if (SYMBOLP (definition
) && partial
)
2810 tem
= Fget (definition
, suppress
);
2812 if (!NILP (tem
)) continue;
2815 /* Set CHARACTER to the character this entry describes, if any.
2816 Also update *INDICES. */
2817 if (CHAR_TABLE_P (vector
))
2819 indices
[char_table_depth
] = i
;
2821 if (char_table_depth
== 0)
2824 indices
[0] = i
- 128;
2826 else if (complete_char
)
2829 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
2837 /* If this binding is shadowed by some other map, ignore it. */
2838 if (!NILP (shadow
) && complete_char
)
2842 XVECTOR (kludge
)->contents
[0] = make_number (character
);
2843 tem
= shadow_lookup (shadow
, kludge
, Qt
);
2845 if (!NILP (tem
)) continue;
2848 /* Ignore this definition if it is shadowed by an earlier
2849 one in the same keymap. */
2850 if (!NILP (entire_map
) && complete_char
)
2854 XVECTOR (kludge
)->contents
[0] = make_number (character
);
2855 tem
= Flookup_key (entire_map
, kludge
, Qt
);
2857 if (! EQ (tem
, definition
))
2863 if (char_table_depth
== 0)
2868 /* For a sub char-table, show the depth by indentation.
2869 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
2870 if (char_table_depth
> 0)
2871 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
2873 /* Output the prefix that applies to every entry in this map. */
2874 if (!NILP (elt_prefix
))
2875 insert1 (elt_prefix
);
2877 /* Insert or describe the character this slot is for,
2878 or a description of what it is for. */
2879 if (SUB_CHAR_TABLE_P (vector
))
2882 insert_char (character
);
2885 /* We need an octal representation for this block of
2888 sprintf (work
, "(row %d)", i
);
2889 insert (work
, strlen (work
));
2892 else if (CHAR_TABLE_P (vector
))
2895 insert1 (Fsingle_key_description (make_number (character
)));
2898 /* Print the information for this character set. */
2899 insert_string ("<");
2900 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
2902 insert_from_string (tem2
, 0 , XSTRING (tem2
)->size
, 0);
2910 insert1 (Fsingle_key_description (make_number (character
)));
2913 /* If we find a sub char-table within a char-table,
2914 scan it recursively; it defines the details for
2915 a character set or a portion of a character set. */
2916 if (multibyte
&& CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
2919 describe_vector (definition
, elt_prefix
, elt_describer
,
2920 partial
, shadow
, entire_map
,
2921 indices
, char_table_depth
+ 1);
2927 /* Find all consecutive characters or rows that have the same
2928 definition. But, for elements of a top level char table, if
2929 they are for charsets, we had better describe one by one even
2930 if they have the same definition. */
2931 if (CHAR_TABLE_P (vector
))
2935 if (char_table_depth
== 0)
2936 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
2938 while (i
+ 1 < limit
2939 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
2941 && !NILP (Fequal (tem2
, definition
)))
2946 && (tem2
= get_keyelt (XVECTOR (vector
)->contents
[i
+ 1], 0),
2948 && !NILP (Fequal (tem2
, definition
)))
2952 /* If we have a range of more than one character,
2953 print where the range reaches to. */
2955 if (i
!= starting_i
)
2959 if (!NILP (elt_prefix
))
2960 insert1 (elt_prefix
);
2962 if (CHAR_TABLE_P (vector
))
2964 if (char_table_depth
== 0)
2966 insert1 (Fsingle_key_description (make_number (i
)));
2968 else if (complete_char
)
2970 indices
[char_table_depth
] = i
;
2972 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
2973 insert_char (character
);
2977 /* We need an octal representation for this block of
2980 sprintf (work
, "(row %d)", i
);
2981 insert (work
, strlen (work
));
2986 insert1 (Fsingle_key_description (make_number (i
)));
2990 /* Print a description of the definition of this character.
2991 elt_describer will take care of spacing out far enough
2992 for alignment purposes. */
2993 (*elt_describer
) (definition
);
2996 /* For (sub) char-table, print `defalt' slot at last. */
2997 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
2999 insert (" ", char_table_depth
* 2);
3000 insert_string ("<<default>>");
3001 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
);
3007 /* Apropos - finding all symbols whose names match a regexp. */
3008 Lisp_Object apropos_predicate
;
3009 Lisp_Object apropos_accumulate
;
3012 apropos_accum (symbol
, string
)
3013 Lisp_Object symbol
, string
;
3015 register Lisp_Object tem
;
3017 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3018 if (!NILP (tem
) && !NILP (apropos_predicate
))
3019 tem
= call1 (apropos_predicate
, symbol
);
3021 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3024 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3025 "Show all symbols whose names contain match for REGEXP.\n\
3026 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3027 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3028 Return list of symbols found.")
3030 Lisp_Object regexp
, predicate
;
3032 struct gcpro gcpro1
, gcpro2
;
3033 CHECK_STRING (regexp
, 0);
3034 apropos_predicate
= predicate
;
3035 GCPRO2 (apropos_predicate
, apropos_accumulate
);
3036 apropos_accumulate
= Qnil
;
3037 map_obarray (Vobarray
, apropos_accum
, regexp
);
3038 apropos_accumulate
= Fsort (apropos_accumulate
, Qstring_lessp
);
3040 return apropos_accumulate
;
3047 Qkeymap
= intern ("keymap");
3048 staticpro (&Qkeymap
);
3050 /* Now we are ready to set up this property, so we can
3051 create char tables. */
3052 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3054 /* Initialize the keymaps standardly used.
3055 Each one is the value of a Lisp variable, and is also
3056 pointed to by a C variable */
3058 global_map
= Fmake_keymap (Qnil
);
3059 Fset (intern ("global-map"), global_map
);
3061 current_global_map
= global_map
;
3062 staticpro (&global_map
);
3063 staticpro (¤t_global_map
);
3065 meta_map
= Fmake_keymap (Qnil
);
3066 Fset (intern ("esc-map"), meta_map
);
3067 Ffset (intern ("ESC-prefix"), meta_map
);
3069 control_x_map
= Fmake_keymap (Qnil
);
3070 Fset (intern ("ctl-x-map"), control_x_map
);
3071 Ffset (intern ("Control-X-prefix"), control_x_map
);
3073 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3074 "List of commands given new key bindings recently.\n\
3075 This is used for internal purposes during Emacs startup;\n\
3076 don't alter it yourself.");
3077 Vdefine_key_rebound_commands
= Qt
;
3079 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3080 "Default keymap to use when reading from the minibuffer.");
3081 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3083 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3084 "Local keymap for the minibuffer when spaces are not allowed.");
3085 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3087 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3088 "Local keymap for minibuffer input with completion.");
3089 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3091 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3092 "Local keymap for minibuffer input with completion, for exact match.");
3093 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3095 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3096 "Alist of keymaps to use for minor modes.\n\
3097 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3098 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3099 If two active keymaps bind the same key, the keymap appearing earlier\n\
3100 in the list takes precedence.");
3101 Vminor_mode_map_alist
= Qnil
;
3103 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3104 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3105 This allows Emacs to recognize function keys sent from ASCII\n\
3106 terminals at any point in a key sequence.\n\
3108 The `read-key-sequence' function replaces any subsequence bound by\n\
3109 `function-key-map' with its binding. More precisely, when the active\n\
3110 keymaps have no binding for the current key sequence but\n\
3111 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3112 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3113 continues with the new sequence.\n\
3115 The events that come from bindings in `function-key-map' are not\n\
3116 themselves looked up in `function-key-map'.\n\
3118 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3119 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3120 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3121 key, typing `ESC O P x' would return [f1 x].");
3122 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3124 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3125 "Keymap of key translations that can override keymaps.\n\
3126 This keymap works like `function-key-map', but comes after that,\n\
3127 and applies even for keys that have ordinary bindings.");
3128 Vkey_translation_map
= Qnil
;
3130 Qsingle_key_description
= intern ("single-key-description");
3131 staticpro (&Qsingle_key_description
);
3133 Qkey_description
= intern ("key-description");
3134 staticpro (&Qkey_description
);
3136 Qkeymapp
= intern ("keymapp");
3137 staticpro (&Qkeymapp
);
3139 Qnon_ascii
= intern ("non-ascii");
3140 staticpro (&Qnon_ascii
);
3142 defsubr (&Skeymapp
);
3143 defsubr (&Skeymap_parent
);
3144 defsubr (&Sset_keymap_parent
);
3145 defsubr (&Smake_keymap
);
3146 defsubr (&Smake_sparse_keymap
);
3147 defsubr (&Scopy_keymap
);
3148 defsubr (&Skey_binding
);
3149 defsubr (&Slocal_key_binding
);
3150 defsubr (&Sglobal_key_binding
);
3151 defsubr (&Sminor_mode_key_binding
);
3152 defsubr (&Sdefine_key
);
3153 defsubr (&Slookup_key
);
3154 defsubr (&Sdefine_prefix_command
);
3155 defsubr (&Suse_global_map
);
3156 defsubr (&Suse_local_map
);
3157 defsubr (&Scurrent_local_map
);
3158 defsubr (&Scurrent_global_map
);
3159 defsubr (&Scurrent_minor_mode_maps
);
3160 defsubr (&Saccessible_keymaps
);
3161 defsubr (&Skey_description
);
3162 defsubr (&Sdescribe_vector
);
3163 defsubr (&Ssingle_key_description
);
3164 defsubr (&Stext_char_description
);
3165 defsubr (&Swhere_is_internal
);
3166 defsubr (&Sdescribe_bindings
);
3167 defsubr (&Sapropos_internal
);
3174 initial_define_key (global_map
, 033, "ESC-prefix");
3175 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");