1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99 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 /* Alist of major-mode-specific overrides for
75 minor mode variables and keymaps. */
76 Lisp_Object Vminor_mode_overriding_map_alist
;
78 /* Keymap mapping ASCII function key sequences onto their preferred forms.
79 Initialized by the terminal-specific lisp files. See DEFVAR for more
81 Lisp_Object Vfunction_key_map
;
83 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
84 Lisp_Object Vkey_translation_map
;
86 /* A list of all commands given new bindings since a certain time
87 when nil was stored here.
88 This is used to speed up recomputation of menu key equivalents
89 when Emacs starts up. t means don't record anything here. */
90 Lisp_Object Vdefine_key_rebound_commands
;
92 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
, Qmenu_item
;
94 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
95 in a string key sequence is equivalent to prefixing with this
97 extern Lisp_Object meta_prefix_char
;
99 extern Lisp_Object Voverriding_local_map
;
101 static Lisp_Object
define_as_prefix ();
102 static Lisp_Object
describe_buffer_bindings ();
103 static void describe_command (), describe_translation ();
104 static void describe_map ();
106 /* Keymap object support - constructors and predicates. */
108 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
109 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
110 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
111 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
112 mouse events, and any other things that appear in the input stream.\n\
113 All entries in it are initially nil, meaning \"command undefined\".\n\n\
114 The optional arg STRING supplies a menu name for the keymap\n\
115 in case you use it as a menu with `x-popup-menu'.")
121 tail
= Fcons (string
, Qnil
);
124 return Fcons (Qkeymap
,
125 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
128 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
129 "Construct and return a new sparse-keymap list.\n\
130 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
131 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
132 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
133 Initially the alist is nil.\n\n\
134 The optional arg STRING supplies a menu name for the keymap\n\
135 in case you use it as a menu with `x-popup-menu'.")
140 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
141 return Fcons (Qkeymap
, Qnil
);
144 /* This function is used for installing the standard key bindings
145 at initialization time.
149 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
152 initial_define_key (keymap
, key
, defname
)
157 store_in_keymap (keymap
, make_number (key
), intern (defname
));
161 initial_define_lispy_key (keymap
, keyname
, defname
)
166 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
169 /* Define character fromchar in map frommap as an alias for character
170 tochar in map tomap. Subsequent redefinitions of the latter WILL
171 affect the former. */
175 synkey (frommap
, fromchar
, tomap
, tochar
)
176 struct Lisp_Vector
*frommap
, *tomap
;
177 int fromchar
, tochar
;
180 XSETVECTOR (v
, tomap
);
181 XSETFASTINT (c
, tochar
);
182 frommap
->contents
[fromchar
] = Fcons (v
, c
);
186 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
187 "Return t if OBJECT is a keymap.\n\
189 A keymap is a list (keymap . ALIST),\n\
190 or a symbol whose function definition is itself a keymap.\n\
191 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
192 a vector of densely packed bindings for small character codes\n\
193 is also allowed as an element.")
197 return (NILP (get_keymap_1 (object
, 0, 0)) ? Qnil
: Qt
);
200 /* Check that OBJECT is a keymap (after dereferencing through any
201 symbols). If it is, return it.
203 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
204 is an autoload form, do the autoload and try again.
205 If AUTOLOAD is nonzero, callers must assume GC is possible.
207 ERROR controls how we respond if OBJECT isn't a keymap.
208 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
210 Note that most of the time, we don't want to pursue autoloads.
211 Functions like Faccessible_keymaps which scan entire keymap trees
212 shouldn't load every autoloaded keymap. I'm not sure about this,
213 but it seems to me that only read_key_sequence, Flookup_key, and
214 Fdefine_key should cause keymaps to be autoloaded. */
217 get_keymap_1 (object
, error
, autoload
)
226 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
230 tem
= indirect_function (object
);
231 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
235 /* Should we do an autoload? Autoload forms for keymaps have
236 Qkeymap as their fifth element. */
240 && EQ (XCAR (tem
), Qautoload
))
244 tail
= Fnth (make_number (4), tem
);
245 if (EQ (tail
, Qkeymap
))
247 struct gcpro gcpro1
, gcpro2
;
249 GCPRO2 (tem
, object
);
250 do_autoload (tem
, object
);
259 wrong_type_argument (Qkeymapp
, object
);
265 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
266 If OBJECT doesn't denote a keymap at all, signal an error. */
271 return get_keymap_1 (object
, 1, 0);
274 /* Return the parent map of the keymap MAP, or nil if it has none.
275 We assume that MAP is a valid keymap. */
277 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
278 "Return the parent keymap of KEYMAP.")
284 keymap
= get_keymap_1 (keymap
, 1, 1);
286 /* Skip past the initial element `keymap'. */
287 list
= XCDR (keymap
);
288 for (; CONSP (list
); list
= XCDR (list
))
290 /* See if there is another `keymap'. */
291 if (EQ (Qkeymap
, XCAR (list
)))
298 /* Set the parent keymap of MAP to PARENT. */
300 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
301 "Modify KEYMAP to set its parent map to PARENT.\n\
302 PARENT should be nil or another keymap.")
304 Lisp_Object keymap
, parent
;
306 Lisp_Object list
, prev
;
309 keymap
= get_keymap_1 (keymap
, 1, 1);
311 parent
= get_keymap_1 (parent
, 1, 1);
313 /* Skip past the initial element `keymap'. */
318 /* If there is a parent keymap here, replace it.
319 If we came to the end, add the parent in PREV. */
320 if (! CONSP (list
) || EQ (Qkeymap
, XCAR (list
)))
322 /* If we already have the right parent, return now
323 so that we avoid the loops below. */
324 if (EQ (XCDR (prev
), parent
))
327 XCDR (prev
) = parent
;
333 /* Scan through for submaps, and set their parents too. */
335 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
337 /* Stop the scan when we come to the parent. */
338 if (EQ (XCAR (list
), Qkeymap
))
341 /* If this element holds a prefix map, deal with it. */
342 if (CONSP (XCAR (list
))
343 && CONSP (XCDR (XCAR (list
))))
344 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
347 if (VECTORP (XCAR (list
)))
348 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
349 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
350 fix_submap_inheritance (keymap
, make_number (i
),
351 XVECTOR (XCAR (list
))->contents
[i
]);
353 if (CHAR_TABLE_P (XCAR (list
)))
355 Lisp_Object indices
[3];
357 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
),
365 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
366 if EVENT is also a prefix in MAP's parent,
367 make sure that SUBMAP inherits that definition as its own parent. */
370 fix_submap_inheritance (map
, event
, submap
)
371 Lisp_Object map
, event
, submap
;
373 Lisp_Object map_parent
, parent_entry
;
375 /* SUBMAP is a cons that we found as a key binding.
376 Discard the other things found in a menu key binding. */
380 /* May be an old format menu item */
381 if (STRINGP (XCAR (submap
)))
383 submap
= XCDR (submap
);
384 /* Also remove a menu help string, if any,
385 following the menu item name. */
386 if (CONSP (submap
) && STRINGP (XCAR (submap
)))
387 submap
= XCDR (submap
);
388 /* Also remove the sublist that caches key equivalences, if any. */
390 && CONSP (XCAR (submap
)))
393 carcar
= XCAR (XCAR (submap
));
394 if (NILP (carcar
) || VECTORP (carcar
))
395 submap
= XCDR (submap
);
399 /* Or a new format menu item */
400 else if (EQ (XCAR (submap
), Qmenu_item
)
401 && CONSP (XCDR (submap
)))
403 submap
= XCDR (XCDR (submap
));
405 submap
= XCAR (submap
);
409 /* If it isn't a keymap now, there's no work to do. */
411 || ! EQ (XCAR (submap
), Qkeymap
))
414 map_parent
= Fkeymap_parent (map
);
415 if (! NILP (map_parent
))
416 parent_entry
= access_keymap (map_parent
, event
, 0, 0);
420 /* If MAP's parent has something other than a keymap,
421 our own submap shadows it completely, so use nil as SUBMAP's parent. */
422 if (! (CONSP (parent_entry
) && EQ (XCAR (parent_entry
), Qkeymap
)))
425 if (! EQ (parent_entry
, submap
))
427 Lisp_Object submap_parent
;
428 submap_parent
= submap
;
432 tem
= Fkeymap_parent (submap_parent
);
433 if (EQ (tem
, parent_entry
))
436 && EQ (XCAR (tem
), Qkeymap
))
441 Fset_keymap_parent (submap_parent
, parent_entry
);
445 /* Look up IDX in MAP. IDX may be any sort of event.
446 Note that this does only one level of lookup; IDX must be a single
447 event, not a sequence.
449 If T_OK is non-zero, bindings for Qt are treated as default
450 bindings; any key left unmentioned by other tables and bindings is
451 given the binding of Qt.
453 If T_OK is zero, bindings for Qt are not treated specially.
455 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
458 access_keymap (map
, idx
, t_ok
, noinherit
)
467 /* If idx is a list (some sort of mouse click, perhaps?),
468 the index we want to use is the car of the list, which
469 ought to be a symbol. */
470 idx
= EVENT_HEAD (idx
);
472 /* If idx is a symbol, it might have modifiers, which need to
473 be put in the canonical order. */
475 idx
= reorder_modifiers (idx
);
476 else if (INTEGERP (idx
))
477 /* Clobber the high bits that can be present on a machine
478 with more than 24 bits of integer. */
479 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
483 Lisp_Object t_binding
;
486 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
490 binding
= XCAR (tail
);
491 if (SYMBOLP (binding
))
493 /* If NOINHERIT, stop finding prefix definitions
494 after we pass a second occurrence of the `keymap' symbol. */
495 if (noinherit
&& EQ (binding
, Qkeymap
) && ! EQ (tail
, map
))
498 else if (CONSP (binding
))
500 if (EQ (XCAR (binding
), idx
))
502 val
= XCDR (binding
);
503 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
506 fix_submap_inheritance (map
, idx
, val
);
509 if (t_ok
&& EQ (XCAR (binding
), Qt
))
510 t_binding
= XCDR (binding
);
512 else if (VECTORP (binding
))
514 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (binding
)->size
)
516 val
= XVECTOR (binding
)->contents
[XFASTINT (idx
)];
517 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
520 fix_submap_inheritance (map
, idx
, val
);
524 else if (CHAR_TABLE_P (binding
))
526 /* Character codes with modifiers
527 are not included in a char-table.
528 All character codes without modifiers are included. */
531 & (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
532 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
)))
534 val
= Faref (binding
, idx
);
535 if (noprefix
&& CONSP (val
) && EQ (XCAR (val
), Qkeymap
))
538 fix_submap_inheritance (map
, idx
, val
);
550 /* Given OBJECT which was found in a slot in a keymap,
551 trace indirect definitions to get the actual definition of that slot.
552 An indirect definition is a list of the form
553 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
554 and INDEX is the object to look up in KEYMAP to yield the definition.
556 Also if OBJECT has a menu string as the first element,
557 remove that. Also remove a menu help string as second element.
559 If AUTOLOAD is nonzero, load autoloadable keymaps
560 that are referred to with indirection. */
563 get_keyelt (object
, autoload
)
564 register Lisp_Object object
;
569 if (!(CONSP (object
)))
570 /* This is really the value. */
573 /* If the keymap contents looks like (keymap ...) or (lambda ...)
575 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
578 /* If the keymap contents looks like (menu-item name . DEFN)
579 or (menu-item name DEFN ...) then use DEFN.
580 This is a new format menu item.
582 else if (EQ (XCAR (object
), Qmenu_item
))
584 if (CONSP (XCDR (object
)))
586 object
= XCDR (XCDR (object
));
588 object
= XCAR (object
);
595 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
596 Keymap alist elements like (CHAR MENUSTRING . DEFN)
597 will be used by HierarKey menus. */
598 else if (STRINGP (XCAR (object
)))
600 object
= XCDR (object
);
601 /* Also remove a menu help string, if any,
602 following the menu item name. */
603 if (CONSP (object
) && STRINGP (XCAR (object
)))
604 object
= XCDR (object
);
605 /* Also remove the sublist that caches key equivalences, if any. */
606 if (CONSP (object
) && CONSP (XCAR (object
)))
609 carcar
= XCAR (XCAR (object
));
610 if (NILP (carcar
) || VECTORP (carcar
))
611 object
= XCDR (object
);
615 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
618 register Lisp_Object map
;
619 map
= get_keymap_1 (Fcar_safe (object
), 0, autoload
);
627 if (INTEGERP (key
) && (XINT (key
) & meta_modifier
))
629 object
= access_keymap (map
, meta_prefix_char
, 0, 0);
630 map
= get_keymap_1 (object
, 0, autoload
);
631 object
= access_keymap (map
, make_number (XINT (key
)
636 object
= access_keymap (map
, key
, 0, 0);
643 store_in_keymap (keymap
, idx
, def
)
645 register Lisp_Object idx
;
646 register Lisp_Object def
;
648 /* If we are preparing to dump, and DEF is a menu element
649 with a menu item indicator, copy it to ensure it is not pure. */
650 if (CONSP (def
) && PURE_P (def
)
651 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
652 def
= Fcons (XCAR (def
), XCDR (def
));
654 if (!CONSP (keymap
) || ! EQ (XCAR (keymap
), Qkeymap
))
655 error ("attempt to define a key in a non-keymap");
657 /* If idx is a list (some sort of mouse click, perhaps?),
658 the index we want to use is the car of the list, which
659 ought to be a symbol. */
660 idx
= EVENT_HEAD (idx
);
662 /* If idx is a symbol, it might have modifiers, which need to
663 be put in the canonical order. */
665 idx
= reorder_modifiers (idx
);
666 else if (INTEGERP (idx
))
667 /* Clobber the high bits that can be present on a machine
668 with more than 24 bits of integer. */
669 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
671 /* Scan the keymap for a binding of idx. */
675 /* The cons after which we should insert new bindings. If the
676 keymap has a table element, we record its position here, so new
677 bindings will go after it; this way, the table will stay
678 towards the front of the alist and character lookups in dense
679 keymaps will remain fast. Otherwise, this just points at the
680 front of the keymap. */
681 Lisp_Object insertion_point
;
683 insertion_point
= keymap
;
684 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
691 if (NATNUMP (idx
) && XFASTINT (idx
) < XVECTOR (elt
)->size
)
693 XVECTOR (elt
)->contents
[XFASTINT (idx
)] = def
;
696 insertion_point
= tail
;
698 else if (CHAR_TABLE_P (elt
))
700 /* Character codes with modifiers
701 are not included in a char-table.
702 All character codes without modifiers are included. */
705 & (CHAR_ALT
| CHAR_SUPER
| CHAR_HYPER
706 | CHAR_SHIFT
| CHAR_CTL
| CHAR_META
)))
708 Faset (elt
, idx
, def
);
711 insertion_point
= tail
;
713 else if (CONSP (elt
))
715 if (EQ (idx
, XCAR (elt
)))
721 else if (SYMBOLP (elt
))
723 /* If we find a 'keymap' symbol in the spine of KEYMAP,
724 then we must have found the start of a second keymap
725 being used as the tail of KEYMAP, and a binding for IDX
726 should be inserted before it. */
727 if (EQ (elt
, Qkeymap
))
735 /* We have scanned the entire keymap, and not found a binding for
736 IDX. Let's add one. */
737 XCDR (insertion_point
)
738 = Fcons (Fcons (idx
, def
), XCDR (insertion_point
));
745 copy_keymap_1 (chartable
, idx
, elt
)
746 Lisp_Object chartable
, idx
, elt
;
748 if (!SYMBOLP (elt
) && ! NILP (Fkeymapp (elt
)))
749 Faset (chartable
, idx
, Fcopy_keymap (elt
));
752 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
753 "Return a copy of the keymap KEYMAP.\n\
754 The copy starts out with the same definitions of KEYMAP,\n\
755 but changing either the copy or KEYMAP does not affect the other.\n\
756 Any key definitions that are subkeymaps are recursively copied.\n\
757 However, a key definition which is a symbol whose definition is a keymap\n\
762 register Lisp_Object copy
, tail
;
764 copy
= Fcopy_alist (get_keymap (keymap
));
766 for (tail
= copy
; CONSP (tail
); tail
= XCDR (tail
))
771 if (CHAR_TABLE_P (elt
))
773 Lisp_Object indices
[3];
775 elt
= Fcopy_sequence (elt
);
778 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, 0, indices
);
780 else if (VECTORP (elt
))
784 elt
= Fcopy_sequence (elt
);
787 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
788 if (!SYMBOLP (XVECTOR (elt
)->contents
[i
])
789 && ! NILP (Fkeymapp (XVECTOR (elt
)->contents
[i
])))
790 XVECTOR (elt
)->contents
[i
]
791 = Fcopy_keymap (XVECTOR (elt
)->contents
[i
]);
793 else if (CONSP (elt
) && CONSP (XCDR (elt
)))
798 /* Is this a new format menu item. */
799 if (EQ (XCAR (tem
),Qmenu_item
))
801 /* Copy cell with menu-item marker. */
803 = Fcons (XCAR (tem
), XCDR (tem
));
808 /* Copy cell with menu-item name. */
810 = Fcons (XCAR (tem
), XCDR (tem
));
816 /* Copy cell with binding and if the binding is a keymap,
819 = Fcons (XCAR (tem
), XCDR (tem
));
822 if (!(SYMBOLP (tem
) || NILP (Fkeymapp (tem
))))
823 XCAR (elt
) = Fcopy_keymap (tem
);
825 if (CONSP (tem
) && CONSP (XCAR (tem
)))
826 /* Delete cache for key equivalences. */
827 XCDR (elt
) = XCDR (tem
);
832 /* It may be an old fomat menu item.
833 Skip the optional menu string.
835 if (STRINGP (XCAR (tem
)))
837 /* Copy the cell, since copy-alist didn't go this deep. */
839 = Fcons (XCAR (tem
), XCDR (tem
));
842 /* Also skip the optional menu help string. */
843 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
846 = Fcons (XCAR (tem
), XCDR (tem
));
850 /* There may also be a list that caches key equivalences.
851 Just delete it for the new keymap. */
853 && CONSP (XCAR (tem
))
854 && (NILP (XCAR (XCAR (tem
)))
855 || VECTORP (XCAR (XCAR (tem
)))))
856 XCDR (elt
) = XCDR (tem
);
859 && ! SYMBOLP (XCDR (elt
))
860 && ! NILP (Fkeymapp (XCDR (elt
))))
861 XCDR (elt
) = Fcopy_keymap (XCDR (elt
));
870 /* Simple Keymap mutators and accessors. */
872 /* GC is possible in this function if it autoloads a keymap. */
874 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
875 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
876 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
877 meaning a sequence of keystrokes and events.\n\
878 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
879 can be included if you use a vector.\n\
880 DEF is anything that can be a key's definition:\n\
881 nil (means key is undefined in this keymap),\n\
882 a command (a Lisp function suitable for interactive calling)\n\
883 a string (treated as a keyboard macro),\n\
884 a keymap (to define a prefix key),\n\
885 a symbol. When the key is looked up, the symbol will stand for its\n\
886 function definition, which should at that time be one of the above,\n\
887 or another symbol whose function definition is used, etc.\n\
888 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
889 (DEFN should be a valid definition in its own right),\n\
890 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
892 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
893 the front of KEYMAP.")
900 register Lisp_Object c
;
901 register Lisp_Object cmd
;
905 struct gcpro gcpro1
, gcpro2
, gcpro3
;
907 keymap
= get_keymap_1 (keymap
, 1, 1);
909 if (!VECTORP (key
) && !STRINGP (key
))
910 key
= wrong_type_argument (Qarrayp
, key
);
912 length
= XFASTINT (Flength (key
));
916 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
917 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
919 GCPRO3 (keymap
, key
, def
);
922 meta_bit
= meta_modifier
;
929 c
= Faref (key
, make_number (idx
));
931 if (CONSP (c
) && lucid_event_type_list_p (c
))
932 c
= Fevent_convert_list (c
);
935 && (XINT (c
) & meta_bit
)
938 c
= meta_prefix_char
;
944 XSETINT (c
, XINT (c
) & ~meta_bit
);
950 if (! INTEGERP (c
) && ! SYMBOLP (c
) && ! CONSP (c
))
951 error ("Key sequence contains invalid events");
954 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
956 cmd
= get_keyelt (access_keymap (keymap
, c
, 0, 1), 1);
958 /* If this key is undefined, make it a prefix. */
960 cmd
= define_as_prefix (keymap
, c
);
962 keymap
= get_keymap_1 (cmd
, 0, 1);
964 /* We must use Fkey_description rather than just passing key to
965 error; key might be a vector, not a string. */
966 error ("Key sequence %s uses invalid prefix characters",
967 XSTRING (Fkey_description (key
))->data
);
971 /* Value is number if KEY is too long; NIL if valid but has no definition. */
972 /* GC is possible in this function if it autoloads a keymap. */
974 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
975 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
976 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
978 A number as value means KEY is \"too long\";\n\
979 that is, characters or symbols in it except for the last one\n\
980 fail to be a valid sequence of prefix characters in KEYMAP.\n\
981 The number is how many characters at the front of KEY\n\
982 it takes to reach a non-prefix command.\n\
984 Normally, `lookup-key' ignores bindings for t, which act as default\n\
985 bindings, used when nothing else in the keymap applies; this makes it\n\
986 usable as a general function for probing keymaps. However, if the\n\
987 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
988 recognize the default bindings, just as `read-key-sequence' does.")
989 (keymap
, key
, accept_default
)
990 register Lisp_Object keymap
;
992 Lisp_Object accept_default
;
995 register Lisp_Object cmd
;
996 register Lisp_Object c
;
999 int t_ok
= ! NILP (accept_default
);
1001 struct gcpro gcpro1
;
1003 keymap
= get_keymap_1 (keymap
, 1, 1);
1005 if (!VECTORP (key
) && !STRINGP (key
))
1006 key
= wrong_type_argument (Qarrayp
, key
);
1008 length
= XFASTINT (Flength (key
));
1013 meta_bit
= meta_modifier
;
1022 c
= Faref (key
, make_number (idx
));
1024 if (CONSP (c
) && lucid_event_type_list_p (c
))
1025 c
= Fevent_convert_list (c
);
1028 && (XINT (c
) & meta_bit
)
1031 c
= meta_prefix_char
;
1037 XSETINT (c
, XINT (c
) & ~meta_bit
);
1043 cmd
= get_keyelt (access_keymap (keymap
, c
, t_ok
, 0), 1);
1045 RETURN_UNGCPRO (cmd
);
1047 keymap
= get_keymap_1 (cmd
, 0, 1);
1049 RETURN_UNGCPRO (make_number (idx
));
1055 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1056 Assume that currently it does not define C at all.
1057 Return the keymap. */
1060 define_as_prefix (keymap
, c
)
1061 Lisp_Object keymap
, c
;
1063 Lisp_Object inherit
, cmd
;
1065 cmd
= Fmake_sparse_keymap (Qnil
);
1066 /* If this key is defined as a prefix in an inherited keymap,
1067 make it a prefix in this map, and make its definition
1068 inherit the other prefix definition. */
1069 inherit
= access_keymap (keymap
, c
, 0, 0);
1071 /* This code is needed to do the right thing in the following case:
1072 keymap A inherits from B,
1073 you define KEY as a prefix in A,
1074 then later you define KEY as a prefix in B.
1075 We want the old prefix definition in A to inherit from that in B.
1076 It is hard to do that retroactively, so this code
1077 creates the prefix in B right away.
1079 But it turns out that this code causes problems immediately
1080 when the prefix in A is defined: it causes B to define KEY
1081 as a prefix with no subcommands.
1083 So I took out this code. */
1086 /* If there's an inherited keymap
1087 and it doesn't define this key,
1088 make it define this key. */
1091 for (tail
= Fcdr (keymap
); CONSP (tail
); tail
= XCDR (tail
))
1092 if (EQ (XCAR (tail
), Qkeymap
))
1096 inherit
= define_as_prefix (tail
, c
);
1100 cmd
= nconc2 (cmd
, inherit
);
1101 store_in_keymap (keymap
, c
, cmd
);
1106 /* Append a key to the end of a key sequence. We always make a vector. */
1109 append_key (key_sequence
, key
)
1110 Lisp_Object key_sequence
, key
;
1112 Lisp_Object args
[2];
1114 args
[0] = key_sequence
;
1116 args
[1] = Fcons (key
, Qnil
);
1117 return Fvconcat (2, args
);
1121 /* Global, local, and minor mode keymap stuff. */
1123 /* We can't put these variables inside current_minor_maps, since under
1124 some systems, static gets macro-defined to be the empty string.
1126 static Lisp_Object
*cmm_modes
, *cmm_maps
;
1127 static int cmm_size
;
1129 /* Error handler used in current_minor_maps. */
1131 current_minor_maps_error ()
1136 /* Store a pointer to an array of the keymaps of the currently active
1137 minor modes in *buf, and return the number of maps it contains.
1139 This function always returns a pointer to the same buffer, and may
1140 free or reallocate it, so if you want to keep it for a long time or
1141 hand it out to lisp code, copy it. This procedure will be called
1142 for every key sequence read, so the nice lispy approach (return a
1143 new assoclist, list, what have you) for each invocation would
1144 result in a lot of consing over time.
1146 If we used xrealloc/xmalloc and ran out of memory, they would throw
1147 back to the command loop, which would try to read a key sequence,
1148 which would call this function again, resulting in an infinite
1149 loop. Instead, we'll use realloc/malloc and silently truncate the
1150 list, let the key sequence be read, and hope some other piece of
1151 code signals the error. */
1153 current_minor_maps (modeptr
, mapptr
)
1154 Lisp_Object
**modeptr
, **mapptr
;
1157 int list_number
= 0;
1158 Lisp_Object alist
, assoc
, var
, val
;
1159 Lisp_Object lists
[2];
1161 lists
[0] = Vminor_mode_overriding_map_alist
;
1162 lists
[1] = Vminor_mode_map_alist
;
1164 for (list_number
= 0; list_number
< 2; list_number
++)
1165 for (alist
= lists
[list_number
];
1167 alist
= XCDR (alist
))
1168 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1169 && (var
= XCAR (assoc
), SYMBOLP (var
))
1170 && (val
= find_symbol_value (var
), ! EQ (val
, Qunbound
))
1175 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1176 and also an entry in Vminor_mode_map_alist,
1177 ignore the latter. */
1178 if (list_number
== 1)
1180 val
= assq_no_quit (var
, lists
[0]);
1187 Lisp_Object
*newmodes
, *newmaps
;
1194 = (Lisp_Object
*) realloc (cmm_modes
,
1195 cmm_size
* sizeof (Lisp_Object
));
1197 = (Lisp_Object
*) realloc (cmm_maps
,
1198 cmm_size
* sizeof (Lisp_Object
));
1206 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1208 = (Lisp_Object
*) malloc (cmm_size
* sizeof (Lisp_Object
));
1212 if (newmaps
&& newmodes
)
1214 cmm_modes
= newmodes
;
1221 /* Get the keymap definition--or nil if it is not defined. */
1222 temp
= internal_condition_case_1 (Findirect_function
,
1224 Qerror
, current_minor_maps_error
);
1228 cmm_maps
[i
] = temp
;
1233 if (modeptr
) *modeptr
= cmm_modes
;
1234 if (mapptr
) *mapptr
= cmm_maps
;
1238 /* GC is possible in this function if it autoloads a keymap. */
1240 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 2, 0,
1241 "Return the binding for command KEY in current keymaps.\n\
1242 KEY is a string or vector, a sequence of keystrokes.\n\
1243 The binding is probably a symbol with a function definition.\n\
1245 Normally, `key-binding' ignores bindings for t, which act as default\n\
1246 bindings, used when nothing else in the keymap applies; this makes it\n\
1247 usable as a general function for probing keymaps. However, if the\n\
1248 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1249 recognize the default bindings, just as `read-key-sequence' does.")
1250 (key
, accept_default
)
1251 Lisp_Object key
, accept_default
;
1253 Lisp_Object
*maps
, value
;
1255 struct gcpro gcpro1
;
1259 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1261 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1262 key
, accept_default
);
1263 if (! NILP (value
) && !INTEGERP (value
))
1264 RETURN_UNGCPRO (value
);
1266 else if (!NILP (Voverriding_local_map
))
1268 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1269 if (! NILP (value
) && !INTEGERP (value
))
1270 RETURN_UNGCPRO (value
);
1276 nmaps
= current_minor_maps (0, &maps
);
1277 /* Note that all these maps are GCPRO'd
1278 in the places where we found them. */
1280 for (i
= 0; i
< nmaps
; i
++)
1281 if (! NILP (maps
[i
]))
1283 value
= Flookup_key (maps
[i
], key
, accept_default
);
1284 if (! NILP (value
) && !INTEGERP (value
))
1285 RETURN_UNGCPRO (value
);
1288 local
= get_local_map (PT
, current_buffer
);
1292 value
= Flookup_key (local
, key
, accept_default
);
1293 if (! NILP (value
) && !INTEGERP (value
))
1294 RETURN_UNGCPRO (value
);
1298 value
= Flookup_key (current_global_map
, key
, accept_default
);
1300 if (! NILP (value
) && !INTEGERP (value
))
1306 /* GC is possible in this function if it autoloads a keymap. */
1308 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1309 "Return the binding for command KEYS in current local keymap only.\n\
1310 KEYS is a string, a sequence of keystrokes.\n\
1311 The binding is probably a symbol with a function definition.\n\
1313 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1314 bindings; see the description of `lookup-key' for more details about this.")
1315 (keys
, accept_default
)
1316 Lisp_Object keys
, accept_default
;
1318 register Lisp_Object map
;
1319 map
= current_buffer
->keymap
;
1322 return Flookup_key (map
, keys
, accept_default
);
1325 /* GC is possible in this function if it autoloads a keymap. */
1327 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1328 "Return the binding for command KEYS in current global keymap only.\n\
1329 KEYS is a string, a sequence of keystrokes.\n\
1330 The binding is probably a symbol with a function definition.\n\
1331 This function's return values are the same as those of lookup-key\n\
1334 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1335 bindings; see the description of `lookup-key' for more details about this.")
1336 (keys
, accept_default
)
1337 Lisp_Object keys
, accept_default
;
1339 return Flookup_key (current_global_map
, keys
, accept_default
);
1342 /* GC is possible in this function if it autoloads a keymap. */
1344 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1345 "Find the visible minor mode bindings of KEY.\n\
1346 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1347 the symbol which names the minor mode binding KEY, and BINDING is\n\
1348 KEY's definition in that mode. In particular, if KEY has no\n\
1349 minor-mode bindings, return nil. If the first binding is a\n\
1350 non-prefix, all subsequent bindings will be omitted, since they would\n\
1351 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1352 that come after prefix bindings.\n\
1354 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1355 bindings; see the description of `lookup-key' for more details about this.")
1356 (key
, accept_default
)
1357 Lisp_Object key
, accept_default
;
1359 Lisp_Object
*modes
, *maps
;
1361 Lisp_Object binding
;
1363 struct gcpro gcpro1
, gcpro2
;
1365 nmaps
= current_minor_maps (&modes
, &maps
);
1366 /* Note that all these maps are GCPRO'd
1367 in the places where we found them. */
1370 GCPRO2 (key
, binding
);
1372 for (i
= j
= 0; i
< nmaps
; i
++)
1373 if (! NILP (maps
[i
])
1374 && ! NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1375 && !INTEGERP (binding
))
1377 if (! NILP (get_keymap (binding
)))
1378 maps
[j
++] = Fcons (modes
[i
], binding
);
1380 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1384 return Flist (j
, maps
);
1387 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1388 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1389 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1390 If a second optional argument MAPVAR is given, the map is stored as\n\
1391 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1393 The third optional argument NAME, if given, supplies a menu name\n\
1394 string for the map. This is required to use the keymap as a menu.")
1395 (command
, mapvar
, name
)
1396 Lisp_Object command
, mapvar
, name
;
1399 map
= Fmake_sparse_keymap (name
);
1400 Ffset (command
, map
);
1404 Fset (command
, map
);
1408 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1409 "Select KEYMAP as the global keymap.")
1413 keymap
= get_keymap (keymap
);
1414 current_global_map
= keymap
;
1419 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1420 "Select KEYMAP as the local keymap.\n\
1421 If KEYMAP is nil, that means no local keymap.")
1426 keymap
= get_keymap (keymap
);
1428 current_buffer
->keymap
= keymap
;
1433 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1434 "Return current buffer's local keymap, or nil if it has none.")
1437 return current_buffer
->keymap
;
1440 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1441 "Return the current global keymap.")
1444 return current_global_map
;
1447 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1448 "Return a list of keymaps for the minor modes of the current buffer.")
1452 int nmaps
= current_minor_maps (0, &maps
);
1454 return Flist (nmaps
, maps
);
1457 /* Help functions for describing and documenting keymaps. */
1459 static void accessible_keymaps_char_table ();
1461 /* This function cannot GC. */
1463 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1465 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1466 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1467 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1468 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1469 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1470 then the value includes only maps for prefixes that start with PREFIX.")
1472 Lisp_Object keymap
, prefix
;
1474 Lisp_Object maps
, good_maps
, tail
;
1477 /* no need for gcpro because we don't autoload any keymaps. */
1480 prefixlen
= XINT (Flength (prefix
));
1484 /* If a prefix was specified, start with the keymap (if any) for
1485 that prefix, so we don't waste time considering other prefixes. */
1487 tem
= Flookup_key (keymap
, prefix
, Qt
);
1488 /* Flookup_key may give us nil, or a number,
1489 if the prefix is not defined in this particular map.
1490 It might even give us a list that isn't a keymap. */
1491 tem
= get_keymap_1 (tem
, 0, 0);
1494 /* Convert PREFIX to a vector now, so that later on
1495 we don't have to deal with the possibility of a string. */
1496 if (STRINGP (prefix
))
1501 copy
= Fmake_vector (make_number (XSTRING (prefix
)->size
), Qnil
);
1502 for (i
= 0, i_byte
= 0; i
< XSTRING (prefix
)->size
;)
1505 if (STRING_MULTIBYTE (prefix
))
1506 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1509 c
= XSTRING (prefix
)->data
[i
++];
1511 c
^= 0200 | meta_modifier
;
1513 XVECTOR (copy
)->contents
[i_before
] = make_number (c
);
1517 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1523 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1524 get_keymap (keymap
)),
1527 /* For each map in the list maps,
1528 look at any other maps it points to,
1529 and stick them at the end if they are not already in the list.
1531 This is a breadth-first traversal, where tail is the queue of
1532 nodes, and maps accumulates a list of all nodes visited. */
1534 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1536 register Lisp_Object thisseq
, thismap
;
1538 /* Does the current sequence end in the meta-prefix-char? */
1541 thisseq
= Fcar (Fcar (tail
));
1542 thismap
= Fcdr (Fcar (tail
));
1543 last
= make_number (XINT (Flength (thisseq
)) - 1);
1544 is_metized
= (XINT (last
) >= 0
1545 /* Don't metize the last char of PREFIX. */
1546 && XINT (last
) >= prefixlen
1547 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1549 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1553 elt
= XCAR (thismap
);
1557 if (CHAR_TABLE_P (elt
))
1559 Lisp_Object indices
[3];
1561 map_char_table (accessible_keymaps_char_table
, Qnil
,
1562 elt
, Fcons (maps
, Fcons (tail
, thisseq
)),
1565 else if (VECTORP (elt
))
1569 /* Vector keymap. Scan all the elements. */
1570 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
1572 register Lisp_Object tem
;
1573 register Lisp_Object cmd
;
1575 cmd
= get_keyelt (XVECTOR (elt
)->contents
[i
], 0);
1576 if (NILP (cmd
)) continue;
1577 tem
= Fkeymapp (cmd
);
1580 cmd
= get_keymap (cmd
);
1581 /* Ignore keymaps that are already added to maps. */
1582 tem
= Frassq (cmd
, maps
);
1585 /* If the last key in thisseq is meta-prefix-char,
1586 turn it into a meta-ized keystroke. We know
1587 that the event we're about to append is an
1588 ascii keystroke since we're processing a
1592 int meta_bit
= meta_modifier
;
1593 tem
= Fcopy_sequence (thisseq
);
1595 Faset (tem
, last
, make_number (i
| meta_bit
));
1597 /* This new sequence is the same length as
1598 thisseq, so stick it in the list right
1601 = Fcons (Fcons (tem
, cmd
), XCDR (tail
));
1605 tem
= append_key (thisseq
, make_number (i
));
1606 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1612 else if (CONSP (elt
))
1614 register Lisp_Object cmd
, tem
;
1616 cmd
= get_keyelt (XCDR (elt
), 0);
1617 /* Ignore definitions that aren't keymaps themselves. */
1618 tem
= Fkeymapp (cmd
);
1621 /* Ignore keymaps that have been seen already. */
1622 cmd
= get_keymap (cmd
);
1623 tem
= Frassq (cmd
, maps
);
1626 /* Let elt be the event defined by this map entry. */
1629 /* If the last key in thisseq is meta-prefix-char, and
1630 this entry is a binding for an ascii keystroke,
1631 turn it into a meta-ized keystroke. */
1632 if (is_metized
&& INTEGERP (elt
))
1634 Lisp_Object element
;
1637 tem
= Fvconcat (1, &element
);
1638 XSETFASTINT (XVECTOR (tem
)->contents
[XINT (last
)],
1639 XINT (elt
) | meta_modifier
);
1641 /* This new sequence is the same length as
1642 thisseq, so stick it in the list right
1645 = Fcons (Fcons (tem
, cmd
), XCDR (tail
));
1649 Fcons (Fcons (append_key (thisseq
, elt
), cmd
),
1660 /* Now find just the maps whose access prefixes start with PREFIX. */
1663 for (; CONSP (maps
); maps
= XCDR (maps
))
1665 Lisp_Object elt
, thisseq
;
1667 thisseq
= XCAR (elt
);
1668 /* The access prefix must be at least as long as PREFIX,
1669 and the first elements must match those of PREFIX. */
1670 if (XINT (Flength (thisseq
)) >= prefixlen
)
1673 for (i
= 0; i
< prefixlen
; i
++)
1676 XSETFASTINT (i1
, i
);
1677 if (!EQ (Faref (thisseq
, i1
), Faref (prefix
, i1
)))
1681 good_maps
= Fcons (elt
, good_maps
);
1685 return Fnreverse (good_maps
);
1689 accessible_keymaps_char_table (args
, index
, cmd
)
1690 Lisp_Object args
, index
, cmd
;
1693 Lisp_Object maps
, tail
, thisseq
;
1699 tail
= XCAR (XCDR (args
));
1700 thisseq
= XCDR (XCDR (args
));
1702 tem
= Fkeymapp (cmd
);
1705 cmd
= get_keymap (cmd
);
1706 /* Ignore keymaps that are already added to maps. */
1707 tem
= Frassq (cmd
, maps
);
1710 tem
= append_key (thisseq
, index
);
1711 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1716 Lisp_Object Qsingle_key_description
, Qkey_description
;
1718 /* This function cannot GC. */
1720 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1721 "Return a pretty description of key-sequence KEYS.\n\
1722 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1723 spaces are put between sequence elements, etc.")
1735 vector
= Fmake_vector (Flength (keys
), Qnil
);
1736 for (i
= 0, i_byte
= 0; i
< XSTRING (keys
)->size
; )
1741 if (STRING_MULTIBYTE (keys
))
1742 FETCH_STRING_CHAR_ADVANCE (c
, keys
, i
, i_byte
);
1745 c
= XSTRING (keys
)->data
[i
++];
1747 c
^= 0200 | meta_modifier
;
1750 XSETFASTINT (XVECTOR (vector
)->contents
[i_before
], c
);
1757 /* In effect, this computes
1758 (mapconcat 'single-key-description keys " ")
1759 but we shouldn't use mapconcat because it can do GC. */
1761 len
= XVECTOR (keys
)->size
;
1762 sep
= build_string (" ");
1763 /* This has one extra element at the end that we don't pass to Fconcat. */
1764 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1766 for (i
= 0; i
< len
; i
++)
1768 args
[i
* 2] = Fsingle_key_description (XVECTOR (keys
)->contents
[i
]);
1769 args
[i
* 2 + 1] = sep
;
1772 else if (CONSP (keys
))
1774 /* In effect, this computes
1775 (mapconcat 'single-key-description keys " ")
1776 but we shouldn't use mapconcat because it can do GC. */
1778 len
= XFASTINT (Flength (keys
));
1779 sep
= build_string (" ");
1780 /* This has one extra element at the end that we don't pass to Fconcat. */
1781 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1783 for (i
= 0; i
< len
; i
++)
1785 args
[i
* 2] = Fsingle_key_description (XCAR (keys
));
1786 args
[i
* 2 + 1] = sep
;
1791 keys
= wrong_type_argument (Qarrayp
, keys
);
1793 return Fconcat (len
* 2 - 1, args
);
1797 push_key_description (c
, p
)
1798 register unsigned int c
;
1801 /* Clear all the meaningless bits above the meta bit. */
1802 c
&= meta_modifier
| ~ - meta_modifier
;
1804 if (c
& alt_modifier
)
1810 if (c
& ctrl_modifier
)
1816 if (c
& hyper_modifier
)
1820 c
-= hyper_modifier
;
1822 if (c
& meta_modifier
)
1828 if (c
& shift_modifier
)
1832 c
-= shift_modifier
;
1834 if (c
& super_modifier
)
1838 c
-= super_modifier
;
1854 else if (c
== Ctl ('M'))
1864 if (c
> 0 && c
<= Ctl ('Z'))
1883 || (NILP (current_buffer
->enable_multibyte_characters
)
1884 && SINGLE_BYTE_CHAR_P (c
)))
1888 if (! NILP (current_buffer
->enable_multibyte_characters
))
1889 c
= unibyte_char_to_multibyte (c
);
1891 if (NILP (current_buffer
->enable_multibyte_characters
)
1892 || SINGLE_BYTE_CHAR_P (c
)
1893 || ! char_valid_p (c
, 0))
1897 /* The biggest character code uses 19 bits. */
1898 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
1900 if (c
>= (1 << bit_offset
))
1901 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
1906 p
+= CHAR_STRING (c
, p
);
1913 /* This function cannot GC. */
1915 DEFUN ("single-key-description", Fsingle_key_description
, Ssingle_key_description
, 1, 1, 0,
1916 "Return a pretty description of command character KEY.\n\
1917 Control characters turn into C-whatever, etc.")
1921 if (CONSP (key
) && lucid_event_type_list_p (key
))
1922 key
= Fevent_convert_list (key
);
1924 key
= EVENT_HEAD (key
);
1926 if (INTEGERP (key
)) /* Normal character */
1928 unsigned int charset
, c1
, c2
;
1929 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
1931 if (SINGLE_BYTE_CHAR_P (without_bits
))
1934 SPLIT_NON_ASCII_CHAR (without_bits
, charset
, c1
, c2
);
1937 && CHARSET_DEFINED_P (charset
)
1938 && ((c1
>= 0 && c1
< 32)
1939 || (c2
>= 0 && c2
< 32)))
1941 /* Handle a generic character. */
1943 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
1944 CHECK_STRING (name
, 0);
1945 return concat2 (build_string ("Character set "), name
);
1949 char tem
[KEY_DESCRIPTION_SIZE
];
1951 *push_key_description (XUINT (key
), tem
) = 0;
1952 return build_string (tem
);
1955 else if (SYMBOLP (key
)) /* Function key or event-symbol */
1956 return Fsymbol_name (key
);
1957 else if (STRINGP (key
)) /* Buffer names in the menubar. */
1958 return Fcopy_sequence (key
);
1960 error ("KEY must be an integer, cons, symbol, or string");
1964 push_text_char_description (c
, p
)
1965 register unsigned int c
;
1977 *p
++ = c
+ 64; /* 'A' - 1 */
1989 /* This function cannot GC. */
1991 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
1992 "Return a pretty description of file-character CHARACTER.\n\
1993 Control characters turn into \"^char\", etc.")
1995 Lisp_Object character
;
1997 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
1998 unsigned char str
[6];
2001 CHECK_NUMBER (character
, 0);
2003 c
= XINT (character
);
2004 if (!SINGLE_BYTE_CHAR_P (c
))
2006 int len
= CHAR_STRING (c
, str
);
2008 return make_multibyte_string (str
, 1, len
);
2011 *push_text_char_description (c
& 0377, str
) = 0;
2013 return build_string (str
);
2016 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2019 ascii_sequence_p (seq
)
2023 int len
= XINT (Flength (seq
));
2025 for (i
= 0; i
< len
; i
++)
2027 Lisp_Object ii
, elt
;
2029 XSETFASTINT (ii
, i
);
2030 elt
= Faref (seq
, ii
);
2033 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2041 /* where-is - finding a command in a set of keymaps. */
2043 static Lisp_Object
where_is_internal_1 ();
2044 static void where_is_internal_2 ();
2046 /* This function can GC if Flookup_key autoloads any keymaps. */
2048 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 4, 0,
2049 "Return list of keys that invoke DEFINITION.\n\
2050 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2051 If KEYMAP is nil, search all the currently active keymaps.\n\
2053 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2054 rather than a list of all possible key sequences.\n\
2055 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2056 no matter what it is.\n\
2057 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2058 and entirely reject menu bindings.\n\
2060 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2061 to other keymaps or slots. This makes it possible to search for an\n\
2062 indirect definition itself.")
2063 (definition
, keymap
, firstonly
, noindirect
)
2064 Lisp_Object definition
, keymap
;
2065 Lisp_Object firstonly
, noindirect
;
2068 Lisp_Object found
, sequences
;
2069 Lisp_Object keymap1
;
2070 int keymap_specified
= !NILP (keymap
);
2071 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2072 /* 1 means ignore all menu bindings entirely. */
2073 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2075 /* Find keymaps accessible from `keymap' or the current
2076 context. But don't muck with the value of `keymap',
2077 because `where_is_internal_1' uses it to check for
2078 shadowed bindings. */
2080 if (! keymap_specified
)
2081 keymap1
= get_local_map (PT
, current_buffer
);
2083 if (!NILP (keymap1
))
2084 maps
= nconc2 (Faccessible_keymaps (get_keymap (keymap1
), Qnil
),
2085 Faccessible_keymaps (get_keymap (current_global_map
),
2088 maps
= Faccessible_keymaps (get_keymap (current_global_map
), Qnil
);
2090 /* Put the minor mode keymaps on the front. */
2091 if (! keymap_specified
)
2094 minors
= Fnreverse (Fcurrent_minor_mode_maps ());
2095 while (!NILP (minors
))
2097 maps
= nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors
)),
2100 minors
= XCDR (minors
);
2104 GCPRO5 (definition
, keymap
, maps
, found
, sequences
);
2108 for (; !NILP (maps
); maps
= Fcdr (maps
))
2110 /* Key sequence to reach map, and the map that it reaches */
2111 register Lisp_Object
this, map
;
2113 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2114 [M-CHAR] sequences, check if last character of the sequence
2115 is the meta-prefix char. */
2119 this = Fcar (Fcar (maps
));
2120 map
= Fcdr (Fcar (maps
));
2121 last
= make_number (XINT (Flength (this)) - 1);
2122 last_is_meta
= (XINT (last
) >= 0
2123 && EQ (Faref (this, last
), meta_prefix_char
));
2129 /* Because the code we want to run on each binding is rather
2130 large, we don't want to have two separate loop bodies for
2131 sparse keymap bindings and tables; we want to iterate one
2132 loop body over both keymap and vector bindings.
2134 For this reason, if Fcar (map) is a vector, we don't
2135 advance map to the next element until i indicates that we
2136 have finished off the vector. */
2137 Lisp_Object elt
, key
, binding
;
2145 /* Set key and binding to the current key and binding, and
2146 advance map and i to the next binding. */
2149 Lisp_Object sequence
;
2151 /* In a vector, look at each element. */
2152 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2154 binding
= XVECTOR (elt
)->contents
[i
];
2155 XSETFASTINT (key
, i
);
2156 sequence
= where_is_internal_1 (binding
, key
, definition
,
2157 noindirect
, keymap
, this,
2158 last
, nomenus
, last_is_meta
);
2159 if (!NILP (sequence
))
2160 sequences
= Fcons (sequence
, sequences
);
2163 else if (CHAR_TABLE_P (elt
))
2165 Lisp_Object indices
[3];
2168 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2169 Fcons (keymap
, Qnil
)),
2170 Fcons (Fcons (this, last
),
2171 Fcons (make_number (nomenus
),
2172 make_number (last_is_meta
))));
2174 map_char_table (where_is_internal_2
, Qnil
, elt
, args
,
2176 sequences
= XCDR (XCDR (XCAR (args
)));
2178 else if (CONSP (elt
))
2180 Lisp_Object sequence
;
2183 binding
= XCDR (elt
);
2185 sequence
= where_is_internal_1 (binding
, key
, definition
,
2186 noindirect
, keymap
, this,
2187 last
, nomenus
, last_is_meta
);
2188 if (!NILP (sequence
))
2189 sequences
= Fcons (sequence
, sequences
);
2193 for (; ! NILP (sequences
); sequences
= XCDR (sequences
))
2195 Lisp_Object sequence
;
2197 sequence
= XCAR (sequences
);
2199 /* It is a true unshadowed match. Record it, unless it's already
2200 been seen (as could happen when inheriting keymaps). */
2201 if (NILP (Fmember (sequence
, found
)))
2202 found
= Fcons (sequence
, found
);
2204 /* If firstonly is Qnon_ascii, then we can return the first
2205 binding we find. If firstonly is not Qnon_ascii but not
2206 nil, then we should return the first ascii-only binding
2208 if (EQ (firstonly
, Qnon_ascii
))
2209 RETURN_UNGCPRO (sequence
);
2210 else if (! NILP (firstonly
) && ascii_sequence_p (sequence
))
2211 RETURN_UNGCPRO (sequence
);
2218 found
= Fnreverse (found
);
2220 /* firstonly may have been t, but we may have gone all the way through
2221 the keymaps without finding an all-ASCII key sequence. So just
2222 return the best we could find. */
2223 if (! NILP (firstonly
))
2224 return Fcar (found
);
2229 /* This is the function that Fwhere_is_internal calls using map_char_table.
2231 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2233 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2234 Since map_char_table doesn't really use the return value from this function,
2235 we the result append to RESULT, the slot in ARGS. */
2238 where_is_internal_2 (args
, key
, binding
)
2239 Lisp_Object args
, key
, binding
;
2241 Lisp_Object definition
, noindirect
, keymap
, this, last
;
2242 Lisp_Object result
, sequence
;
2243 int nomenus
, last_is_meta
;
2245 result
= XCDR (XCDR (XCAR (args
)));
2246 definition
= XCAR (XCAR (XCAR (args
)));
2247 noindirect
= XCDR (XCAR (XCAR (args
)));
2248 keymap
= XCAR (XCDR (XCAR (args
)));
2249 this = XCAR (XCAR (XCDR (args
)));
2250 last
= XCDR (XCAR (XCDR (args
)));
2251 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2252 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2254 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
,
2255 this, last
, nomenus
, last_is_meta
);
2257 if (!NILP (sequence
))
2258 XCDR (XCDR (XCAR (args
)))
2259 = Fcons (sequence
, result
);
2263 where_is_internal_1 (binding
, key
, definition
, noindirect
, keymap
, this, last
,
2264 nomenus
, last_is_meta
)
2265 Lisp_Object binding
, key
, definition
, noindirect
, keymap
, this, last
;
2266 int nomenus
, last_is_meta
;
2268 Lisp_Object sequence
;
2269 int keymap_specified
= !NILP (keymap
);
2271 /* Search through indirections unless that's not wanted. */
2272 if (NILP (noindirect
))
2278 Lisp_Object map
, tem
;
2279 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2280 map
= get_keymap_1 (Fcar_safe (definition
), 0, 0);
2281 tem
= Fkeymapp (map
);
2283 definition
= access_keymap (map
, Fcdr (definition
), 0, 0);
2287 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2288 if (CONSP (definition
)
2289 && (EQ (XCAR (definition
),Qmenu_item
)
2290 || STRINGP (XCAR (definition
))))
2294 binding
= get_keyelt (binding
, 0);
2297 /* End this iteration if this element does not match
2300 if (CONSP (definition
))
2303 tem
= Fequal (binding
, definition
);
2308 if (!EQ (binding
, definition
))
2311 /* We have found a match.
2312 Construct the key sequence where we found it. */
2313 if (INTEGERP (key
) && last_is_meta
)
2315 sequence
= Fcopy_sequence (this);
2316 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2319 sequence
= append_key (this, key
);
2321 /* Verify that this key binding is not shadowed by another
2322 binding for the same key, before we say it exists.
2324 Mechanism: look for local definition of this key and if
2325 it is defined and does not match what we found then
2328 Either nil or number as value from Flookup_key
2330 if (keymap_specified
)
2332 binding
= Flookup_key (keymap
, sequence
, Qnil
);
2333 if (!NILP (binding
) && !INTEGERP (binding
))
2335 if (CONSP (definition
))
2338 tem
= Fequal (binding
, definition
);
2343 if (!EQ (binding
, definition
))
2349 binding
= Fkey_binding (sequence
, Qnil
);
2350 if (!EQ (binding
, definition
))
2357 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2359 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal
, Sdescribe_bindings_internal
, 0, 2, "",
2360 "Show a list of all defined keys, and their definitions.\n\
2361 We put that list in a buffer, and display the buffer.\n\
2363 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2364 \(Ordinarily these are omitted from the output.)\n\
2365 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2366 then we display only bindings that start with that prefix.")
2368 Lisp_Object menus
, prefix
;
2370 register Lisp_Object thisbuf
;
2371 XSETBUFFER (thisbuf
, current_buffer
);
2372 internal_with_output_to_temp_buffer ("*Help*",
2373 describe_buffer_bindings
,
2374 list3 (thisbuf
, prefix
, menus
));
2378 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2381 describe_buffer_bindings (arg
)
2384 Lisp_Object descbuf
, prefix
, shadow
;
2386 register Lisp_Object start1
;
2387 struct gcpro gcpro1
;
2389 char *alternate_heading
2391 Keyboard translations:\n\n\
2392 You type Translation\n\
2393 -------- -----------\n";
2395 descbuf
= XCAR (arg
);
2397 prefix
= XCAR (arg
);
2399 nomenu
= NILP (XCAR (arg
));
2404 Fset_buffer (Vstandard_output
);
2406 /* Report on alternates for keys. */
2407 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2410 unsigned char *translate
= XSTRING (Vkeyboard_translate_table
)->data
;
2411 int translate_len
= XSTRING (Vkeyboard_translate_table
)->size
;
2413 for (c
= 0; c
< translate_len
; c
++)
2414 if (translate
[c
] != c
)
2416 char buf
[KEY_DESCRIPTION_SIZE
];
2419 if (alternate_heading
)
2421 insert_string (alternate_heading
);
2422 alternate_heading
= 0;
2425 bufend
= push_key_description (translate
[c
], buf
);
2426 insert (buf
, bufend
- buf
);
2427 Findent_to (make_number (16), make_number (1));
2428 bufend
= push_key_description (c
, buf
);
2429 insert (buf
, bufend
- buf
);
2437 if (!NILP (Vkey_translation_map
))
2438 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2439 "Key translations", nomenu
, 1, 0);
2443 Lisp_Object
*modes
, *maps
;
2445 /* Temporarily switch to descbuf, so that we can get that buffer's
2446 minor modes correctly. */
2447 Fset_buffer (descbuf
);
2449 if (!NILP (current_kboard
->Voverriding_terminal_local_map
)
2450 || !NILP (Voverriding_local_map
))
2453 nmaps
= current_minor_maps (&modes
, &maps
);
2454 Fset_buffer (Vstandard_output
);
2456 /* Print the minor mode maps. */
2457 for (i
= 0; i
< nmaps
; i
++)
2459 /* The title for a minor mode keymap
2460 is constructed at run time.
2461 We let describe_map_tree do the actual insertion
2462 because it takes care of other features when doing so. */
2465 if (!SYMBOLP (modes
[i
]))
2468 p
= title
= (char *) alloca (40 + XSYMBOL (modes
[i
])->name
->size
);
2470 bcopy (XSYMBOL (modes
[i
])->name
->data
, p
,
2471 XSYMBOL (modes
[i
])->name
->size
);
2472 p
+= XSYMBOL (modes
[i
])->name
->size
;
2474 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2475 p
+= sizeof (" Minor Mode Bindings") - 1;
2478 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2479 shadow
= Fcons (maps
[i
], shadow
);
2483 /* Print the (major mode) local map. */
2484 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2485 start1
= current_kboard
->Voverriding_terminal_local_map
;
2486 else if (!NILP (Voverriding_local_map
))
2487 start1
= Voverriding_local_map
;
2489 start1
= XBUFFER (descbuf
)->keymap
;
2493 describe_map_tree (start1
, 1, shadow
, prefix
,
2494 "Major Mode Bindings", nomenu
, 0, 0);
2495 shadow
= Fcons (start1
, shadow
);
2498 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2499 "Global Bindings", nomenu
, 0, 1);
2501 /* Print the function-key-map translations under this prefix. */
2502 if (!NILP (Vfunction_key_map
))
2503 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2504 "Function key map translations", nomenu
, 1, 0);
2506 call0 (intern ("help-mode"));
2507 Fset_buffer (descbuf
);
2512 /* Insert a description of the key bindings in STARTMAP,
2513 followed by those of all maps reachable through STARTMAP.
2514 If PARTIAL is nonzero, omit certain "uninteresting" commands
2515 (such as `undefined').
2516 If SHADOW is non-nil, it is a list of maps;
2517 don't mention keys which would be shadowed by any of them.
2518 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2519 TITLE, if not 0, is a string to insert at the beginning.
2520 TITLE should not end with a colon or a newline; we supply that.
2521 If NOMENU is not 0, then omit menu-bar commands.
2523 If TRANSL is nonzero, the definitions are actually key translations
2524 so print strings and vectors differently.
2526 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2530 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2532 Lisp_Object startmap
, shadow
, prefix
;
2539 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2540 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2547 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2550 GCPRO3 (maps
, seen
, sub_shadows
);
2556 /* Delete from MAPS each element that is for the menu bar. */
2557 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2559 Lisp_Object elt
, prefix
, tem
;
2562 prefix
= Fcar (elt
);
2563 if (XVECTOR (prefix
)->size
>= 1)
2565 tem
= Faref (prefix
, make_number (0));
2566 if (EQ (tem
, Qmenu_bar
))
2567 maps
= Fdelq (elt
, maps
);
2572 if (!NILP (maps
) || always_title
)
2576 insert_string (title
);
2579 insert_string (" Starting With ");
2580 insert1 (Fkey_description (prefix
));
2582 insert_string (":\n");
2584 insert_string (key_heading
);
2588 for (; !NILP (maps
); maps
= Fcdr (maps
))
2590 register Lisp_Object elt
, prefix
, tail
;
2593 prefix
= Fcar (elt
);
2597 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2601 shmap
= XCAR (tail
);
2603 /* If the sequence by which we reach this keymap is zero-length,
2604 then the shadow map for this keymap is just SHADOW. */
2605 if ((STRINGP (prefix
) && XSTRING (prefix
)->size
== 0)
2606 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2608 /* If the sequence by which we reach this keymap actually has
2609 some elements, then the sequence's definition in SHADOW is
2610 what we should use. */
2613 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2614 if (INTEGERP (shmap
))
2618 /* If shmap is not nil and not a keymap,
2619 it completely shadows this map, so don't
2620 describe this map at all. */
2621 if (!NILP (shmap
) && NILP (Fkeymapp (shmap
)))
2625 sub_shadows
= Fcons (shmap
, sub_shadows
);
2628 /* Maps we have already listed in this loop shadow this map. */
2629 for (tail
= orig_maps
; ! EQ (tail
, maps
); tail
= XCDR (tail
))
2632 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
2634 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
2637 describe_map (Fcdr (elt
), prefix
,
2638 transl
? describe_translation
: describe_command
,
2639 partial
, sub_shadows
, &seen
, nomenu
);
2645 insert_string ("\n");
2650 static int previous_description_column
;
2653 describe_command (definition
)
2654 Lisp_Object definition
;
2656 register Lisp_Object tem1
;
2657 int column
= current_column ();
2658 int description_column
;
2660 /* If column 16 is no good, go to col 32;
2661 but don't push beyond that--go to next line instead. */
2665 description_column
= 32;
2667 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
2668 description_column
= 32;
2670 description_column
= 16;
2672 Findent_to (make_number (description_column
), make_number (1));
2673 previous_description_column
= description_column
;
2675 if (SYMBOLP (definition
))
2677 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2679 insert_string ("\n");
2681 else if (STRINGP (definition
) || VECTORP (definition
))
2682 insert_string ("Keyboard Macro\n");
2685 tem1
= Fkeymapp (definition
);
2687 insert_string ("Prefix Command\n");
2689 insert_string ("??\n");
2694 describe_translation (definition
)
2695 Lisp_Object definition
;
2697 register Lisp_Object tem1
;
2699 Findent_to (make_number (16), make_number (1));
2701 if (SYMBOLP (definition
))
2703 XSETSTRING (tem1
, XSYMBOL (definition
)->name
);
2705 insert_string ("\n");
2707 else if (STRINGP (definition
) || VECTORP (definition
))
2709 insert1 (Fkey_description (definition
));
2710 insert_string ("\n");
2714 tem1
= Fkeymapp (definition
);
2716 insert_string ("Prefix Command\n");
2718 insert_string ("??\n");
2722 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2723 Returns the first non-nil binding found in any of those maps. */
2726 shadow_lookup (shadow
, key
, flag
)
2727 Lisp_Object shadow
, key
, flag
;
2729 Lisp_Object tail
, value
;
2731 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2733 value
= Flookup_key (XCAR (tail
), key
, flag
);
2740 /* Describe the contents of map MAP, assuming that this map itself is
2741 reached by the sequence of prefix keys KEYS (a string or vector).
2742 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2745 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
2746 register Lisp_Object map
;
2748 void (*elt_describer
) P_ ((Lisp_Object
));
2754 Lisp_Object elt_prefix
;
2755 Lisp_Object tail
, definition
, event
;
2757 Lisp_Object suppress
;
2760 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2762 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
2764 /* Call Fkey_description first, to avoid GC bug for the other string. */
2765 tem
= Fkey_description (keys
);
2766 elt_prefix
= concat2 (tem
, build_string (" "));
2772 suppress
= intern ("suppress-keymap");
2774 /* This vector gets used to present single keys to Flookup_key. Since
2775 that is done once per keymap element, we don't want to cons up a
2776 fresh vector every time. */
2777 kludge
= Fmake_vector (make_number (1), Qnil
);
2780 GCPRO3 (elt_prefix
, definition
, kludge
);
2782 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
2786 if (VECTORP (XCAR (tail
))
2787 || CHAR_TABLE_P (XCAR (tail
)))
2788 describe_vector (XCAR (tail
),
2789 elt_prefix
, elt_describer
, partial
, shadow
, map
,
2791 else if (CONSP (XCAR (tail
)))
2793 event
= XCAR (XCAR (tail
));
2795 /* Ignore bindings whose "keys" are not really valid events.
2796 (We get these in the frames and buffers menu.) */
2797 if (! (SYMBOLP (event
) || INTEGERP (event
)))
2800 if (nomenu
&& EQ (event
, Qmenu_bar
))
2803 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
2805 /* Don't show undefined commands or suppressed commands. */
2806 if (NILP (definition
)) continue;
2807 if (SYMBOLP (definition
) && partial
)
2809 tem
= Fget (definition
, suppress
);
2814 /* Don't show a command that isn't really visible
2815 because a local definition of the same key shadows it. */
2817 XVECTOR (kludge
)->contents
[0] = event
;
2820 tem
= shadow_lookup (shadow
, kludge
, Qt
);
2821 if (!NILP (tem
)) continue;
2824 tem
= Flookup_key (map
, kludge
, Qt
);
2825 if (! EQ (tem
, definition
)) continue;
2829 previous_description_column
= 0;
2834 if (!NILP (elt_prefix
))
2835 insert1 (elt_prefix
);
2837 /* THIS gets the string to describe the character EVENT. */
2838 insert1 (Fsingle_key_description (event
));
2840 /* Print a description of the definition of this character.
2841 elt_describer will take care of spacing out far enough
2842 for alignment purposes. */
2843 (*elt_describer
) (definition
);
2845 else if (EQ (XCAR (tail
), Qkeymap
))
2847 /* The same keymap might be in the structure twice, if we're
2848 using an inherited keymap. So skip anything we've already
2850 tem
= Fassq (tail
, *seen
);
2851 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), keys
)))
2853 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
2861 describe_vector_princ (elt
)
2864 Findent_to (make_number (16), make_number (1));
2869 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 1, 0,
2870 "Insert a description of contents of VECTOR.\n\
2871 This is text showing the elements of vector matched against indices.")
2875 int count
= specpdl_ptr
- specpdl
;
2877 specbind (Qstandard_output
, Fcurrent_buffer ());
2878 CHECK_VECTOR_OR_CHAR_TABLE (vector
, 0);
2879 describe_vector (vector
, Qnil
, describe_vector_princ
, 0,
2880 Qnil
, Qnil
, (int *)0, 0);
2882 return unbind_to (count
, Qnil
);
2885 /* Insert in the current buffer a description of the contents of VECTOR.
2886 We call ELT_DESCRIBER to insert the description of one value found
2889 ELT_PREFIX describes what "comes before" the keys or indices defined
2890 by this vector. This is a human-readable string whose size
2891 is not necessarily related to the situation.
2893 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2894 leads to this keymap.
2896 If the vector is a chartable, ELT_PREFIX is the vector
2897 of bytes that lead to the character set or portion of a character
2898 set described by this chartable.
2900 If PARTIAL is nonzero, it means do not mention suppressed commands
2901 (that assumes the vector is in a keymap).
2903 SHADOW is a list of keymaps that shadow this map.
2904 If it is non-nil, then we look up the key in those maps
2905 and we don't mention it now if it is defined by any of them.
2907 ENTIRE_MAP is the keymap in which this vector appears.
2908 If the definition in effect in the whole map does not match
2909 the one in this vector, we ignore this one.
2911 When describing a sub-char-table, INDICES is a list of
2912 indices at higher levels in this char-table,
2913 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2916 describe_vector (vector
, elt_prefix
, elt_describer
,
2917 partial
, shadow
, entire_map
,
2918 indices
, char_table_depth
)
2919 register Lisp_Object vector
;
2920 Lisp_Object elt_prefix
;
2921 void (*elt_describer
) P_ ((Lisp_Object
));
2924 Lisp_Object entire_map
;
2926 int char_table_depth
;
2928 Lisp_Object definition
;
2931 Lisp_Object suppress
;
2934 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2935 /* Range of elements to be handled. */
2937 /* A flag to tell if a leaf in this level of char-table is not a
2938 generic character (i.e. a complete multibyte character). */
2944 indices
= (int *) alloca (3 * sizeof (int));
2948 /* This vector gets used to present single keys to Flookup_key. Since
2949 that is done once per vector element, we don't want to cons up a
2950 fresh vector every time. */
2951 kludge
= Fmake_vector (make_number (1), Qnil
);
2952 GCPRO3 (elt_prefix
, definition
, kludge
);
2955 suppress
= intern ("suppress-keymap");
2957 if (CHAR_TABLE_P (vector
))
2959 if (char_table_depth
== 0)
2961 /* VECTOR is a top level char-table. */
2964 to
= CHAR_TABLE_ORDINARY_SLOTS
;
2968 /* VECTOR is a sub char-table. */
2969 if (char_table_depth
>= 3)
2970 /* A char-table is never that deep. */
2971 error ("Too deep char table");
2974 = (CHARSET_VALID_P (indices
[0])
2975 && ((CHARSET_DIMENSION (indices
[0]) == 1
2976 && char_table_depth
== 1)
2977 || char_table_depth
== 2));
2979 /* Meaningful elements are from 32th to 127th. */
2981 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
2986 /* This does the right thing for ordinary vectors. */
2990 to
= XVECTOR (vector
)->size
;
2993 for (i
= from
; i
< to
; i
++)
2997 if (CHAR_TABLE_P (vector
))
2999 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3002 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3003 && !CHARSET_DEFINED_P (i
- 128))
3007 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3010 definition
= get_keyelt (XVECTOR (vector
)->contents
[i
], 0);
3012 if (NILP (definition
)) continue;
3014 /* Don't mention suppressed commands. */
3015 if (SYMBOLP (definition
) && partial
)
3019 tem
= Fget (definition
, suppress
);
3021 if (!NILP (tem
)) continue;
3024 /* Set CHARACTER to the character this entry describes, if any.
3025 Also update *INDICES. */
3026 if (CHAR_TABLE_P (vector
))
3028 indices
[char_table_depth
] = i
;
3030 if (char_table_depth
== 0)
3033 indices
[0] = i
- 128;
3035 else if (complete_char
)
3038 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
3046 /* If this binding is shadowed by some other map, ignore it. */
3047 if (!NILP (shadow
) && complete_char
)
3051 XVECTOR (kludge
)->contents
[0] = make_number (character
);
3052 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3054 if (!NILP (tem
)) continue;
3057 /* Ignore this definition if it is shadowed by an earlier
3058 one in the same keymap. */
3059 if (!NILP (entire_map
) && complete_char
)
3063 XVECTOR (kludge
)->contents
[0] = make_number (character
);
3064 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3066 if (! EQ (tem
, definition
))
3072 if (char_table_depth
== 0)
3077 /* For a sub char-table, show the depth by indentation.
3078 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3079 if (char_table_depth
> 0)
3080 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3082 /* Output the prefix that applies to every entry in this map. */
3083 if (!NILP (elt_prefix
))
3084 insert1 (elt_prefix
);
3086 /* Insert or describe the character this slot is for,
3087 or a description of what it is for. */
3088 if (SUB_CHAR_TABLE_P (vector
))
3091 insert_char (character
);
3094 /* We need an octal representation for this block of
3097 sprintf (work
, "(row %d)", i
);
3098 insert (work
, strlen (work
));
3101 else if (CHAR_TABLE_P (vector
))
3104 insert1 (Fsingle_key_description (make_number (character
)));
3107 /* Print the information for this character set. */
3108 insert_string ("<");
3109 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3111 insert_from_string (tem2
, 0, 0, XSTRING (tem2
)->size
,
3112 STRING_BYTES (XSTRING (tem2
)), 0);
3120 insert1 (Fsingle_key_description (make_number (character
)));
3123 /* If we find a sub char-table within a char-table,
3124 scan it recursively; it defines the details for
3125 a character set or a portion of a character set. */
3126 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3129 describe_vector (definition
, elt_prefix
, elt_describer
,
3130 partial
, shadow
, entire_map
,
3131 indices
, char_table_depth
+ 1);
3137 /* Find all consecutive characters or rows that have the same
3138 definition. But, for elements of a top level char table, if
3139 they are for charsets, we had better describe one by one even
3140 if they have the same definition. */
3141 if (CHAR_TABLE_P (vector
))
3145 if (char_table_depth
== 0)
3146 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3148 while (i
+ 1 < limit
3149 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3151 && !NILP (Fequal (tem2
, definition
)))
3156 && (tem2
= get_keyelt (XVECTOR (vector
)->contents
[i
+ 1], 0),
3158 && !NILP (Fequal (tem2
, definition
)))
3162 /* If we have a range of more than one character,
3163 print where the range reaches to. */
3165 if (i
!= starting_i
)
3169 if (!NILP (elt_prefix
))
3170 insert1 (elt_prefix
);
3172 if (CHAR_TABLE_P (vector
))
3174 if (char_table_depth
== 0)
3176 insert1 (Fsingle_key_description (make_number (i
)));
3178 else if (complete_char
)
3180 indices
[char_table_depth
] = i
;
3182 = MAKE_NON_ASCII_CHAR (indices
[0], indices
[1], indices
[2]);
3183 insert_char (character
);
3187 /* We need an octal representation for this block of
3190 sprintf (work
, "(row %d)", i
);
3191 insert (work
, strlen (work
));
3196 insert1 (Fsingle_key_description (make_number (i
)));
3200 /* Print a description of the definition of this character.
3201 elt_describer will take care of spacing out far enough
3202 for alignment purposes. */
3203 (*elt_describer
) (definition
);
3206 /* For (sub) char-table, print `defalt' slot at last. */
3207 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3209 insert (" ", char_table_depth
* 2);
3210 insert_string ("<<default>>");
3211 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
);
3217 /* Apropos - finding all symbols whose names match a regexp. */
3218 Lisp_Object apropos_predicate
;
3219 Lisp_Object apropos_accumulate
;
3222 apropos_accum (symbol
, string
)
3223 Lisp_Object symbol
, string
;
3225 register Lisp_Object tem
;
3227 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3228 if (!NILP (tem
) && !NILP (apropos_predicate
))
3229 tem
= call1 (apropos_predicate
, symbol
);
3231 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3234 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3235 "Show all symbols whose names contain match for REGEXP.\n\
3236 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3237 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3238 Return list of symbols found.")
3240 Lisp_Object regexp
, predicate
;
3242 struct gcpro gcpro1
, gcpro2
;
3243 CHECK_STRING (regexp
, 0);
3244 apropos_predicate
= predicate
;
3245 GCPRO2 (apropos_predicate
, apropos_accumulate
);
3246 apropos_accumulate
= Qnil
;
3247 map_obarray (Vobarray
, apropos_accum
, regexp
);
3248 apropos_accumulate
= Fsort (apropos_accumulate
, Qstring_lessp
);
3250 return apropos_accumulate
;
3256 Qkeymap
= intern ("keymap");
3257 staticpro (&Qkeymap
);
3259 /* Now we are ready to set up this property, so we can
3260 create char tables. */
3261 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3263 /* Initialize the keymaps standardly used.
3264 Each one is the value of a Lisp variable, and is also
3265 pointed to by a C variable */
3267 global_map
= Fmake_keymap (Qnil
);
3268 Fset (intern ("global-map"), global_map
);
3270 current_global_map
= global_map
;
3271 staticpro (&global_map
);
3272 staticpro (¤t_global_map
);
3274 meta_map
= Fmake_keymap (Qnil
);
3275 Fset (intern ("esc-map"), meta_map
);
3276 Ffset (intern ("ESC-prefix"), meta_map
);
3278 control_x_map
= Fmake_keymap (Qnil
);
3279 Fset (intern ("ctl-x-map"), control_x_map
);
3280 Ffset (intern ("Control-X-prefix"), control_x_map
);
3282 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3283 "List of commands given new key bindings recently.\n\
3284 This is used for internal purposes during Emacs startup;\n\
3285 don't alter it yourself.");
3286 Vdefine_key_rebound_commands
= Qt
;
3288 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3289 "Default keymap to use when reading from the minibuffer.");
3290 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3292 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3293 "Local keymap for the minibuffer when spaces are not allowed.");
3294 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3296 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3297 "Local keymap for minibuffer input with completion.");
3298 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3300 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3301 "Local keymap for minibuffer input with completion, for exact match.");
3302 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3304 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3305 "Alist of keymaps to use for minor modes.\n\
3306 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3307 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3308 If two active keymaps bind the same key, the keymap appearing earlier\n\
3309 in the list takes precedence.");
3310 Vminor_mode_map_alist
= Qnil
;
3312 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3313 "Alist of keymaps to use for minor modes, in current major mode.\n\
3314 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3315 used the same way (and before `minor-mode-map-alist'); however,\n\
3316 it is provided for major modes to bind locally.");
3317 Vminor_mode_overriding_map_alist
= Qnil
;
3319 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3320 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3321 This allows Emacs to recognize function keys sent from ASCII\n\
3322 terminals at any point in a key sequence.\n\
3324 The `read-key-sequence' function replaces any subsequence bound by\n\
3325 `function-key-map' with its binding. More precisely, when the active\n\
3326 keymaps have no binding for the current key sequence but\n\
3327 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3328 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3329 continues with the new sequence.\n\
3331 The events that come from bindings in `function-key-map' are not\n\
3332 themselves looked up in `function-key-map'.\n\
3334 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3335 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3336 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3337 key, typing `ESC O P x' would return [f1 x].");
3338 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3340 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3341 "Keymap of key translations that can override keymaps.\n\
3342 This keymap works like `function-key-map', but comes after that,\n\
3343 and applies even for keys that have ordinary bindings.");
3344 Vkey_translation_map
= Qnil
;
3346 Qsingle_key_description
= intern ("single-key-description");
3347 staticpro (&Qsingle_key_description
);
3349 Qkey_description
= intern ("key-description");
3350 staticpro (&Qkey_description
);
3352 Qkeymapp
= intern ("keymapp");
3353 staticpro (&Qkeymapp
);
3355 Qnon_ascii
= intern ("non-ascii");
3356 staticpro (&Qnon_ascii
);
3358 Qmenu_item
= intern ("menu-item");
3359 staticpro (&Qmenu_item
);
3361 defsubr (&Skeymapp
);
3362 defsubr (&Skeymap_parent
);
3363 defsubr (&Sset_keymap_parent
);
3364 defsubr (&Smake_keymap
);
3365 defsubr (&Smake_sparse_keymap
);
3366 defsubr (&Scopy_keymap
);
3367 defsubr (&Skey_binding
);
3368 defsubr (&Slocal_key_binding
);
3369 defsubr (&Sglobal_key_binding
);
3370 defsubr (&Sminor_mode_key_binding
);
3371 defsubr (&Sdefine_key
);
3372 defsubr (&Slookup_key
);
3373 defsubr (&Sdefine_prefix_command
);
3374 defsubr (&Suse_global_map
);
3375 defsubr (&Suse_local_map
);
3376 defsubr (&Scurrent_local_map
);
3377 defsubr (&Scurrent_global_map
);
3378 defsubr (&Scurrent_minor_mode_maps
);
3379 defsubr (&Saccessible_keymaps
);
3380 defsubr (&Skey_description
);
3381 defsubr (&Sdescribe_vector
);
3382 defsubr (&Ssingle_key_description
);
3383 defsubr (&Stext_char_description
);
3384 defsubr (&Swhere_is_internal
);
3385 defsubr (&Sdescribe_bindings_internal
);
3386 defsubr (&Sapropos_internal
);
3392 initial_define_key (global_map
, 033, "ESC-prefix");
3393 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");