1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
30 #include "termhooks.h"
31 #include "blockinput.h"
33 #include "intervals.h"
36 /* The number of elements in keymap vectors. */
37 #define DENSE_TABLE_SIZE (0200)
39 /* Actually allocate storage for these variables */
41 Lisp_Object current_global_map
; /* Current global keymap */
43 Lisp_Object global_map
; /* default global key bindings */
45 Lisp_Object meta_map
; /* The keymap used for globally bound
46 ESC-prefixed default commands */
48 Lisp_Object control_x_map
; /* The keymap used for globally bound
49 C-x-prefixed default commands */
51 /* was MinibufLocalMap */
52 Lisp_Object Vminibuffer_local_map
;
53 /* The keymap used by the minibuf for local
54 bindings when spaces are allowed in the
57 /* was MinibufLocalNSMap */
58 Lisp_Object Vminibuffer_local_ns_map
;
59 /* The keymap used by the minibuf for local
60 bindings when spaces are not encouraged
63 /* keymap used for minibuffers when doing completion */
64 /* was MinibufLocalCompletionMap */
65 Lisp_Object Vminibuffer_local_completion_map
;
67 /* keymap used for minibuffers when doing completion and require a match */
68 /* was MinibufLocalMustMatchMap */
69 Lisp_Object Vminibuffer_local_must_match_map
;
71 /* Alist of minor mode variables and keymaps. */
72 Lisp_Object Vminor_mode_map_alist
;
74 /* Alist of major-mode-specific overrides for
75 minor mode variables and keymaps. */
76 Lisp_Object Vminor_mode_overriding_map_alist
;
78 /* List of emulation mode keymap alists. */
79 Lisp_Object Vemulation_mode_map_alists
;
81 /* Keymap mapping ASCII function key sequences onto their preferred forms.
82 Initialized by the terminal-specific lisp files. See DEFVAR for more
84 Lisp_Object Vfunction_key_map
;
86 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
87 Lisp_Object Vkey_translation_map
;
89 /* A list of all commands given new bindings since a certain time
90 when nil was stored here.
91 This is used to speed up recomputation of menu key equivalents
92 when Emacs starts up. t means don't record anything here. */
93 Lisp_Object Vdefine_key_rebound_commands
;
95 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
, Qmenu_item
, Qremap
;
97 /* Alist of elements like (DEL . "\d"). */
98 static Lisp_Object exclude_keys
;
100 /* Pre-allocated 2-element vector for Fremap_command to use. */
101 static Lisp_Object remap_command_vector
;
103 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
104 in a string key sequence is equivalent to prefixing with this
106 extern Lisp_Object meta_prefix_char
;
108 extern Lisp_Object Voverriding_local_map
;
110 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
111 static Lisp_Object where_is_cache
;
112 /* Which keymaps are reverse-stored in the cache. */
113 static Lisp_Object where_is_cache_keymaps
;
115 static Lisp_Object store_in_keymap
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
116 static void fix_submap_inheritance
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
118 static Lisp_Object define_as_prefix
P_ ((Lisp_Object
, Lisp_Object
));
119 static void describe_command
P_ ((Lisp_Object
, Lisp_Object
));
120 static void describe_translation
P_ ((Lisp_Object
, Lisp_Object
));
121 static void describe_map
P_ ((Lisp_Object
, Lisp_Object
,
122 void (*) P_ ((Lisp_Object
, Lisp_Object
)),
123 int, Lisp_Object
, Lisp_Object
*, int));
124 static void silly_event_symbol_error
P_ ((Lisp_Object
));
126 /* Keymap object support - constructors and predicates. */
128 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
129 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
130 CHARTABLE is a char-table that holds the bindings for the ASCII
131 characters. ALIST is an assoc-list which holds bindings for function keys,
132 mouse events, and any other things that appear in the input stream.
133 All entries in it are initially nil, meaning "command undefined".
135 The optional arg STRING supplies a menu name for the keymap
136 in case you use it as a menu with `x-popup-menu'. */)
142 tail
= Fcons (string
, Qnil
);
145 return Fcons (Qkeymap
,
146 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
149 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
150 doc
: /* Construct and return a new sparse keymap.
151 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
152 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
153 which binds the function key or mouse event SYMBOL to DEFINITION.
154 Initially the alist is nil.
156 The optional arg STRING supplies a menu name for the keymap
157 in case you use it as a menu with `x-popup-menu'. */)
162 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
163 return Fcons (Qkeymap
, Qnil
);
166 /* This function is used for installing the standard key bindings
167 at initialization time.
171 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
174 initial_define_key (keymap
, key
, defname
)
179 store_in_keymap (keymap
, make_number (key
), intern (defname
));
183 initial_define_lispy_key (keymap
, keyname
, defname
)
188 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
191 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
192 doc
: /* Return t if OBJECT is a keymap.
194 A keymap is a list (keymap . ALIST),
195 or a symbol whose function definition is itself a keymap.
196 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
197 a vector of densely packed bindings for small character codes
198 is also allowed as an element. */)
202 return (KEYMAPP (object
) ? Qt
: Qnil
);
205 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
206 doc
: /* Return the prompt-string of a keymap MAP.
207 If non-nil, the prompt is shown in the echo-area
208 when reading a key-sequence to be looked-up in this keymap. */)
214 register Lisp_Object tem
;
223 /* Check that OBJECT is a keymap (after dereferencing through any
224 symbols). If it is, return it.
226 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
227 is an autoload form, do the autoload and try again.
228 If AUTOLOAD is nonzero, callers must assume GC is possible.
230 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
231 is zero as well), return Qt.
233 ERROR controls how we respond if OBJECT isn't a keymap.
234 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
236 Note that most of the time, we don't want to pursue autoloads.
237 Functions like Faccessible_keymaps which scan entire keymap trees
238 shouldn't load every autoloaded keymap. I'm not sure about this,
239 but it seems to me that only read_key_sequence, Flookup_key, and
240 Fdefine_key should cause keymaps to be autoloaded.
242 This function can GC when AUTOLOAD is non-zero, because it calls
243 do_autoload which can GC. */
246 get_keymap (object
, error
, autoload
)
255 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
258 tem
= indirect_function (object
);
261 if (EQ (XCAR (tem
), Qkeymap
))
264 /* Should we do an autoload? Autoload forms for keymaps have
265 Qkeymap as their fifth element. */
266 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
))
270 tail
= Fnth (make_number (4), tem
);
271 if (EQ (tail
, Qkeymap
))
275 struct gcpro gcpro1
, gcpro2
;
277 GCPRO2 (tem
, object
);
278 do_autoload (tem
, object
);
291 wrong_type_argument (Qkeymapp
, object
);
295 /* Return the parent map of KEYMAP, or nil if it has none.
296 We assume that KEYMAP is a valid keymap. */
299 keymap_parent (keymap
, autoload
)
305 keymap
= get_keymap (keymap
, 1, autoload
);
307 /* Skip past the initial element `keymap'. */
308 list
= XCDR (keymap
);
309 for (; CONSP (list
); list
= XCDR (list
))
311 /* See if there is another `keymap'. */
316 return get_keymap (list
, 0, autoload
);
319 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
320 doc
: /* Return the parent keymap of KEYMAP. */)
324 return keymap_parent (keymap
, 1);
327 /* Check whether MAP is one of MAPS parents. */
329 keymap_memberp (map
, maps
)
330 Lisp_Object map
, maps
;
332 if (NILP (map
)) return 0;
333 while (KEYMAPP (maps
) && !EQ (map
, maps
))
334 maps
= keymap_parent (maps
, 0);
335 return (EQ (map
, maps
));
338 /* Set the parent keymap of MAP to PARENT. */
340 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
341 doc
: /* Modify KEYMAP to set its parent map to PARENT.
342 PARENT should be nil or another keymap. */)
344 Lisp_Object keymap
, parent
;
346 Lisp_Object list
, prev
;
347 struct gcpro gcpro1
, gcpro2
;
350 /* Force a keymap flush for the next call to where-is.
351 Since this can be called from within where-is, we don't set where_is_cache
352 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
353 be changed during where-is, while where_is_cache_keymaps is only used at
354 the very beginning of where-is and can thus be changed here without any
356 This is a very minor correctness (rather than safety) issue. */
357 where_is_cache_keymaps
= Qt
;
359 GCPRO2 (keymap
, parent
);
360 keymap
= get_keymap (keymap
, 1, 1);
364 parent
= get_keymap (parent
, 1, 1);
366 /* Check for cycles. */
367 if (keymap_memberp (keymap
, parent
))
368 error ("Cyclic keymap inheritance");
371 /* Skip past the initial element `keymap'. */
376 /* If there is a parent keymap here, replace it.
377 If we came to the end, add the parent in PREV. */
378 if (!CONSP (list
) || KEYMAPP (list
))
380 /* If we already have the right parent, return now
381 so that we avoid the loops below. */
382 if (EQ (XCDR (prev
), parent
))
383 RETURN_UNGCPRO (parent
);
385 XSETCDR (prev
, parent
);
391 /* Scan through for submaps, and set their parents too. */
393 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
395 /* Stop the scan when we come to the parent. */
396 if (EQ (XCAR (list
), Qkeymap
))
399 /* If this element holds a prefix map, deal with it. */
400 if (CONSP (XCAR (list
))
401 && CONSP (XCDR (XCAR (list
))))
402 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
405 if (VECTORP (XCAR (list
)))
406 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
407 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
408 fix_submap_inheritance (keymap
, make_number (i
),
409 XVECTOR (XCAR (list
))->contents
[i
]);
411 if (CHAR_TABLE_P (XCAR (list
)))
413 Lisp_Object indices
[3];
415 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
),
420 RETURN_UNGCPRO (parent
);
423 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
424 if EVENT is also a prefix in MAP's parent,
425 make sure that SUBMAP inherits that definition as its own parent. */
428 fix_submap_inheritance (map
, event
, submap
)
429 Lisp_Object map
, event
, submap
;
431 Lisp_Object map_parent
, parent_entry
;
433 /* SUBMAP is a cons that we found as a key binding.
434 Discard the other things found in a menu key binding. */
436 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
438 /* If it isn't a keymap now, there's no work to do. */
442 map_parent
= keymap_parent (map
, 0);
443 if (!NILP (map_parent
))
445 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
449 /* If MAP's parent has something other than a keymap,
450 our own submap shadows it completely. */
451 if (!CONSP (parent_entry
))
454 if (! EQ (parent_entry
, submap
))
456 Lisp_Object submap_parent
;
457 submap_parent
= submap
;
462 tem
= keymap_parent (submap_parent
, 0);
466 if (keymap_memberp (tem
, parent_entry
))
467 /* Fset_keymap_parent could create a cycle. */
474 Fset_keymap_parent (submap_parent
, parent_entry
);
478 /* Look up IDX in MAP. IDX may be any sort of event.
479 Note that this does only one level of lookup; IDX must be a single
480 event, not a sequence.
482 If T_OK is non-zero, bindings for Qt are treated as default
483 bindings; any key left unmentioned by other tables and bindings is
484 given the binding of Qt.
486 If T_OK is zero, bindings for Qt are not treated specially.
488 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
491 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
500 /* Qunbound in VAL means we have found no binding yet. */
503 /* If idx is a list (some sort of mouse click, perhaps?),
504 the index we want to use is the car of the list, which
505 ought to be a symbol. */
506 idx
= EVENT_HEAD (idx
);
508 /* If idx is a symbol, it might have modifiers, which need to
509 be put in the canonical order. */
511 idx
= reorder_modifiers (idx
);
512 else if (INTEGERP (idx
))
513 /* Clobber the high bits that can be present on a machine
514 with more than 24 bits of integer. */
515 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
517 /* Handle the special meta -> esc mapping. */
518 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
520 /* See if there is a meta-map. If there's none, there is
521 no binding for IDX, unless a default binding exists in MAP. */
523 Lisp_Object meta_map
;
525 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
526 t_ok
, noinherit
, autoload
),
529 if (CONSP (meta_map
))
532 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
535 /* Set IDX to t, so that we only find a default binding. */
538 /* We know there is no binding. */
542 /* t_binding is where we put a default binding that applies,
543 to use in case we do not find a binding specifically
544 for this key sequence. */
547 Lisp_Object t_binding
= Qnil
;
548 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
550 GCPRO4 (map
, tail
, idx
, t_binding
);
552 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
553 If it is 1, only generic-char bindings are accepted.
554 Otherwise, neither are. */
557 for (tail
= XCDR (map
);
559 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
564 binding
= XCAR (tail
);
565 if (SYMBOLP (binding
))
567 /* If NOINHERIT, stop finding prefix definitions
568 after we pass a second occurrence of the `keymap' symbol. */
569 if (noinherit
&& EQ (binding
, Qkeymap
))
570 RETURN_UNGCPRO (Qnil
);
572 else if (CONSP (binding
))
574 Lisp_Object key
= XCAR (binding
);
577 val
= XCDR (binding
);
580 && (XINT (idx
) & CHAR_MODIFIER_MASK
) == 0
582 && (XINT (key
) & CHAR_MODIFIER_MASK
) == 0
583 && !SINGLE_BYTE_CHAR_P (XINT (idx
))
584 && !SINGLE_BYTE_CHAR_P (XINT (key
))
585 && CHAR_VALID_P (XINT (key
), 1)
586 && !CHAR_VALID_P (XINT (key
), 0)
587 && (CHAR_CHARSET (XINT (key
))
588 == CHAR_CHARSET (XINT (idx
))))
590 /* KEY is the generic character of the charset of IDX.
591 Use KEY's binding if there isn't a binding for IDX
593 t_binding
= XCDR (binding
);
596 else if (t_ok
> 1 && EQ (key
, Qt
))
598 t_binding
= XCDR (binding
);
602 else if (VECTORP (binding
))
604 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
605 val
= AREF (binding
, XFASTINT (idx
));
607 else if (CHAR_TABLE_P (binding
))
609 /* Character codes with modifiers
610 are not included in a char-table.
611 All character codes without modifiers are included. */
612 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
614 val
= Faref (binding
, idx
);
615 /* `nil' has a special meaning for char-tables, so
616 we use something else to record an explicitly
623 /* If we found a binding, clean it up and return it. */
624 if (!EQ (val
, Qunbound
))
627 /* A Qt binding is just like an explicit nil binding
628 (i.e. it shadows any parent binding but not bindings in
629 keymaps of lower precedence). */
631 val
= get_keyelt (val
, autoload
);
633 fix_submap_inheritance (map
, idx
, val
);
634 RETURN_UNGCPRO (val
);
639 return get_keyelt (t_binding
, autoload
);
643 /* Given OBJECT which was found in a slot in a keymap,
644 trace indirect definitions to get the actual definition of that slot.
645 An indirect definition is a list of the form
646 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
647 and INDEX is the object to look up in KEYMAP to yield the definition.
649 Also if OBJECT has a menu string as the first element,
650 remove that. Also remove a menu help string as second element.
652 If AUTOLOAD is nonzero, load autoloadable keymaps
653 that are referred to with indirection. */
656 get_keyelt (object
, autoload
)
662 if (!(CONSP (object
)))
663 /* This is really the value. */
666 /* If the keymap contents looks like (keymap ...) or (lambda ...)
668 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
671 /* If the keymap contents looks like (menu-item name . DEFN)
672 or (menu-item name DEFN ...) then use DEFN.
673 This is a new format menu item. */
674 else if (EQ (XCAR (object
), Qmenu_item
))
676 if (CONSP (XCDR (object
)))
680 object
= XCDR (XCDR (object
));
683 object
= XCAR (object
);
685 /* If there's a `:filter FILTER', apply FILTER to the
686 menu-item's definition to get the real definition to
688 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
689 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
692 filter
= XCAR (XCDR (tem
));
693 filter
= list2 (filter
, list2 (Qquote
, object
));
694 object
= menu_item_eval_property (filter
);
699 /* Invalid keymap. */
703 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
704 Keymap alist elements like (CHAR MENUSTRING . DEFN)
705 will be used by HierarKey menus. */
706 else if (STRINGP (XCAR (object
)))
708 object
= XCDR (object
);
709 /* Also remove a menu help string, if any,
710 following the menu item name. */
711 if (CONSP (object
) && STRINGP (XCAR (object
)))
712 object
= XCDR (object
);
713 /* Also remove the sublist that caches key equivalences, if any. */
714 if (CONSP (object
) && CONSP (XCAR (object
)))
717 carcar
= XCAR (XCAR (object
));
718 if (NILP (carcar
) || VECTORP (carcar
))
719 object
= XCDR (object
);
723 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
729 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
731 return (!CONSP (map
) ? object
/* Invalid keymap */
732 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
738 store_in_keymap (keymap
, idx
, def
)
740 register Lisp_Object idx
;
741 register Lisp_Object def
;
743 /* Flush any reverse-map cache. */
744 where_is_cache
= Qnil
;
745 where_is_cache_keymaps
= Qt
;
747 /* If we are preparing to dump, and DEF is a menu element
748 with a menu item indicator, copy it to ensure it is not pure. */
749 if (CONSP (def
) && PURE_P (def
)
750 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
751 def
= Fcons (XCAR (def
), XCDR (def
));
753 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
754 error ("attempt to define a key in a non-keymap");
756 /* If idx is a list (some sort of mouse click, perhaps?),
757 the index we want to use is the car of the list, which
758 ought to be a symbol. */
759 idx
= EVENT_HEAD (idx
);
761 /* If idx is a symbol, it might have modifiers, which need to
762 be put in the canonical order. */
764 idx
= reorder_modifiers (idx
);
765 else if (INTEGERP (idx
))
766 /* Clobber the high bits that can be present on a machine
767 with more than 24 bits of integer. */
768 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
770 /* Scan the keymap for a binding of idx. */
774 /* The cons after which we should insert new bindings. If the
775 keymap has a table element, we record its position here, so new
776 bindings will go after it; this way, the table will stay
777 towards the front of the alist and character lookups in dense
778 keymaps will remain fast. Otherwise, this just points at the
779 front of the keymap. */
780 Lisp_Object insertion_point
;
782 insertion_point
= keymap
;
783 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
790 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
792 ASET (elt
, XFASTINT (idx
), def
);
795 insertion_point
= tail
;
797 else if (CHAR_TABLE_P (elt
))
799 /* Character codes with modifiers
800 are not included in a char-table.
801 All character codes without modifiers are included. */
802 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
805 /* `nil' has a special meaning for char-tables, so
806 we use something else to record an explicitly
808 NILP (def
) ? Qt
: def
);
811 insertion_point
= tail
;
813 else if (CONSP (elt
))
815 if (EQ (idx
, XCAR (elt
)))
821 else if (EQ (elt
, Qkeymap
))
822 /* If we find a 'keymap' symbol in the spine of KEYMAP,
823 then we must have found the start of a second keymap
824 being used as the tail of KEYMAP, and a binding for IDX
825 should be inserted before it. */
832 /* We have scanned the entire keymap, and not found a binding for
833 IDX. Let's add one. */
834 XSETCDR (insertion_point
,
835 Fcons (Fcons (idx
, def
), XCDR (insertion_point
)));
841 EXFUN (Fcopy_keymap
, 1);
844 copy_keymap_item (elt
)
847 Lisp_Object res
, tem
;
854 /* Is this a new format menu item. */
855 if (EQ (XCAR (tem
), Qmenu_item
))
857 /* Copy cell with menu-item marker. */
858 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
862 /* Copy cell with menu-item name. */
863 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
869 /* Copy cell with binding and if the binding is a keymap,
871 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
874 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
875 XSETCAR (elt
, Fcopy_keymap (tem
));
877 if (CONSP (tem
) && CONSP (XCAR (tem
)))
878 /* Delete cache for key equivalences. */
879 XSETCDR (elt
, XCDR (tem
));
884 /* It may be an old fomat menu item.
885 Skip the optional menu string. */
886 if (STRINGP (XCAR (tem
)))
888 /* Copy the cell, since copy-alist didn't go this deep. */
889 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
891 /* Also skip the optional menu help string. */
892 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
894 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
898 /* There may also be a list that caches key equivalences.
899 Just delete it for the new keymap. */
901 && CONSP (XCAR (tem
))
902 && (NILP (XCAR (XCAR (tem
)))
903 || VECTORP (XCAR (XCAR (tem
)))))
905 XSETCDR (elt
, XCDR (tem
));
908 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
909 XSETCDR (elt
, Fcopy_keymap (tem
));
911 else if (EQ (XCAR (tem
), Qkeymap
))
912 res
= Fcopy_keymap (elt
);
918 copy_keymap_1 (chartable
, idx
, elt
)
919 Lisp_Object chartable
, idx
, elt
;
921 Faset (chartable
, idx
, copy_keymap_item (elt
));
924 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
925 doc
: /* Return a copy of the keymap KEYMAP.
926 The copy starts out with the same definitions of KEYMAP,
927 but changing either the copy or KEYMAP does not affect the other.
928 Any key definitions that are subkeymaps are recursively copied.
929 However, a key definition which is a symbol whose definition is a keymap
934 register Lisp_Object copy
, tail
;
935 keymap
= get_keymap (keymap
, 1, 0);
936 copy
= tail
= Fcons (Qkeymap
, Qnil
);
937 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
939 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
941 Lisp_Object elt
= XCAR (keymap
);
942 if (CHAR_TABLE_P (elt
))
944 Lisp_Object indices
[3];
945 elt
= Fcopy_sequence (elt
);
946 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
, 0, indices
);
948 else if (VECTORP (elt
))
951 elt
= Fcopy_sequence (elt
);
952 for (i
= 0; i
< ASIZE (elt
); i
++)
953 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
955 else if (CONSP (elt
))
956 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
957 XSETCDR (tail
, Fcons (elt
, Qnil
));
959 keymap
= XCDR (keymap
);
961 XSETCDR (tail
, keymap
);
965 /* Simple Keymap mutators and accessors. */
967 /* GC is possible in this function if it autoloads a keymap. */
969 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
970 doc
: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.
973 KEY is a string or a vector of symbols and characters meaning a
974 sequence of keystrokes and events. Non-ASCII characters with codes
975 above 127 (such as ISO Latin-1) can be included if you use a vector.
976 Using [t] for KEY creates a default definition, which applies to any
977 event type that has no other definition in thus keymap.
979 DEF is anything that can be a key's definition:
980 nil (means key is undefined in this keymap),
981 a command (a Lisp function suitable for interactive calling)
982 a string (treated as a keyboard macro),
983 a keymap (to define a prefix key),
984 a symbol. When the key is looked up, the symbol will stand for its
985 function definition, which should at that time be one of the above,
986 or another symbol whose function definition is used, etc.
987 a cons (STRING . DEFN), meaning that DEFN is the definition
988 (DEFN should be a valid definition in its own right),
989 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
991 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
992 the front of KEYMAP. */)
999 register Lisp_Object c
;
1000 register Lisp_Object cmd
;
1004 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1006 GCPRO3 (keymap
, key
, def
);
1007 keymap
= get_keymap (keymap
, 1, 1);
1009 if (!VECTORP (key
) && !STRINGP (key
))
1010 key
= wrong_type_argument (Qarrayp
, key
);
1012 length
= XFASTINT (Flength (key
));
1014 RETURN_UNGCPRO (Qnil
);
1016 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1017 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1019 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1024 c
= Faref (key
, make_number (idx
));
1026 if (CONSP (c
) && lucid_event_type_list_p (c
))
1027 c
= Fevent_convert_list (c
);
1030 silly_event_symbol_error (c
);
1033 && (XINT (c
) & meta_bit
)
1036 c
= meta_prefix_char
;
1042 XSETINT (c
, XINT (c
) & ~meta_bit
);
1048 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
))
1049 error ("Key sequence contains invalid event");
1052 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1054 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1056 /* If this key is undefined, make it a prefix. */
1058 cmd
= define_as_prefix (keymap
, c
);
1060 keymap
= get_keymap (cmd
, 0, 1);
1061 if (!CONSP (keymap
))
1062 /* We must use Fkey_description rather than just passing key to
1063 error; key might be a vector, not a string. */
1064 error ("Key sequence %s uses invalid prefix characters",
1065 SDATA (Fkey_description (key
)));
1069 /* This function may GC (it calls Fkey_binding). */
1071 DEFUN ("remap-command", Fremap_command
, Sremap_command
, 1, 1, 0,
1072 doc
: /* Return the remapping for command COMMAND in current keymaps.
1073 Returns nil if COMMAND is not remapped (or not a symbol). */)
1075 Lisp_Object command
;
1077 if (!SYMBOLP (command
))
1080 ASET (remap_command_vector
, 1, command
);
1081 return Fkey_binding (remap_command_vector
, Qnil
, Qt
);
1084 /* Value is number if KEY is too long; nil if valid but has no definition. */
1085 /* GC is possible in this function if it autoloads a keymap. */
1087 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1088 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1089 nil means undefined. See doc of `define-key' for kinds of definitions.
1091 A number as value means KEY is "too long";
1092 that is, characters or symbols in it except for the last one
1093 fail to be a valid sequence of prefix characters in KEYMAP.
1094 The number is how many characters at the front of KEY
1095 it takes to reach a non-prefix command.
1097 Normally, `lookup-key' ignores bindings for t, which act as default
1098 bindings, used when nothing else in the keymap applies; this makes it
1099 usable as a general function for probing keymaps. However, if the
1100 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1101 recognize the default bindings, just as `read-key-sequence' does. */)
1102 (keymap
, key
, accept_default
)
1105 Lisp_Object accept_default
;
1108 register Lisp_Object cmd
;
1109 register Lisp_Object c
;
1111 int t_ok
= !NILP (accept_default
);
1112 struct gcpro gcpro1
, gcpro2
;
1114 GCPRO2 (keymap
, key
);
1115 keymap
= get_keymap (keymap
, 1, 1);
1117 if (!VECTORP (key
) && !STRINGP (key
))
1118 key
= wrong_type_argument (Qarrayp
, key
);
1120 length
= XFASTINT (Flength (key
));
1122 RETURN_UNGCPRO (keymap
);
1127 c
= Faref (key
, make_number (idx
++));
1129 if (CONSP (c
) && lucid_event_type_list_p (c
))
1130 c
= Fevent_convert_list (c
);
1132 /* Turn the 8th bit of string chars into a meta modifier. */
1133 if (XINT (c
) & 0x80 && STRINGP (key
))
1134 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1136 /* Allow string since binding for `menu-bar-select-buffer'
1137 includes the buffer name in the key sequence. */
1138 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1139 error ("Key sequence contains invalid event");
1141 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1143 RETURN_UNGCPRO (cmd
);
1145 keymap
= get_keymap (cmd
, 0, 1);
1146 if (!CONSP (keymap
))
1147 RETURN_UNGCPRO (make_number (idx
));
1153 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1154 Assume that currently it does not define C at all.
1155 Return the keymap. */
1158 define_as_prefix (keymap
, c
)
1159 Lisp_Object keymap
, c
;
1163 cmd
= Fmake_sparse_keymap (Qnil
);
1164 /* If this key is defined as a prefix in an inherited keymap,
1165 make it a prefix in this map, and make its definition
1166 inherit the other prefix definition. */
1167 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1168 store_in_keymap (keymap
, c
, cmd
);
1173 /* Append a key to the end of a key sequence. We always make a vector. */
1176 append_key (key_sequence
, key
)
1177 Lisp_Object key_sequence
, key
;
1179 Lisp_Object args
[2];
1181 args
[0] = key_sequence
;
1183 args
[1] = Fcons (key
, Qnil
);
1184 return Fvconcat (2, args
);
1187 /* Given a event type C which is a symbol,
1188 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1191 silly_event_symbol_error (c
)
1194 Lisp_Object parsed
, base
, name
, assoc
;
1197 parsed
= parse_modifiers (c
);
1198 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1199 base
= XCAR (parsed
);
1200 name
= Fsymbol_name (base
);
1201 /* This alist includes elements such as ("RET" . "\\r"). */
1202 assoc
= Fassoc (name
, exclude_keys
);
1206 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1208 Lisp_Object keystring
;
1209 if (modifiers
& alt_modifier
)
1210 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1211 if (modifiers
& ctrl_modifier
)
1212 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1213 if (modifiers
& hyper_modifier
)
1214 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1215 if (modifiers
& meta_modifier
)
1216 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1217 if (modifiers
& shift_modifier
)
1218 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1219 if (modifiers
& super_modifier
)
1220 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1223 c
= reorder_modifiers (c
);
1224 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1226 error ((modifiers
& ~meta_modifier
1227 ? "To bind the key %s, use [?%s], not [%s]"
1228 : "To bind the key %s, use \"%s\", not [%s]"),
1229 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1230 SDATA (SYMBOL_NAME (c
)));
1234 /* Global, local, and minor mode keymap stuff. */
1236 /* We can't put these variables inside current_minor_maps, since under
1237 some systems, static gets macro-defined to be the empty string.
1239 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1240 static int cmm_size
= 0;
1242 /* Error handler used in current_minor_maps. */
1244 current_minor_maps_error ()
1249 /* Store a pointer to an array of the keymaps of the currently active
1250 minor modes in *buf, and return the number of maps it contains.
1252 This function always returns a pointer to the same buffer, and may
1253 free or reallocate it, so if you want to keep it for a long time or
1254 hand it out to lisp code, copy it. This procedure will be called
1255 for every key sequence read, so the nice lispy approach (return a
1256 new assoclist, list, what have you) for each invocation would
1257 result in a lot of consing over time.
1259 If we used xrealloc/xmalloc and ran out of memory, they would throw
1260 back to the command loop, which would try to read a key sequence,
1261 which would call this function again, resulting in an infinite
1262 loop. Instead, we'll use realloc/malloc and silently truncate the
1263 list, let the key sequence be read, and hope some other piece of
1264 code signals the error. */
1266 current_minor_maps (modeptr
, mapptr
)
1267 Lisp_Object
**modeptr
, **mapptr
;
1270 int list_number
= 0;
1271 Lisp_Object alist
, assoc
, var
, val
;
1272 Lisp_Object emulation_alists
;
1273 Lisp_Object lists
[2];
1275 emulation_alists
= Vemulation_mode_map_alists
;
1276 lists
[0] = Vminor_mode_overriding_map_alist
;
1277 lists
[1] = Vminor_mode_map_alist
;
1279 for (list_number
= 0; list_number
< 2; list_number
++)
1281 if (CONSP (emulation_alists
))
1283 alist
= XCAR (emulation_alists
);
1284 emulation_alists
= XCDR (emulation_alists
);
1285 if (SYMBOLP (alist
))
1286 alist
= find_symbol_value (alist
);
1290 alist
= lists
[list_number
];
1292 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1293 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1294 && (var
= XCAR (assoc
), SYMBOLP (var
))
1295 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1300 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1301 and also an entry in Vminor_mode_map_alist,
1302 ignore the latter. */
1303 if (list_number
== 1)
1305 val
= assq_no_quit (var
, lists
[0]);
1312 int newsize
, allocsize
;
1313 Lisp_Object
*newmodes
, *newmaps
;
1315 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1316 allocsize
= newsize
* sizeof *newmodes
;
1318 /* Use malloc here. See the comment above this function.
1319 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1321 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1326 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1329 cmm_modes
= newmodes
;
1332 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1337 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1344 if (newmodes
== NULL
|| newmaps
== NULL
)
1349 /* Get the keymap definition--or nil if it is not defined. */
1350 temp
= internal_condition_case_1 (Findirect_function
,
1352 Qerror
, current_minor_maps_error
);
1356 cmm_maps
[i
] = temp
;
1362 if (modeptr
) *modeptr
= cmm_modes
;
1363 if (mapptr
) *mapptr
= cmm_maps
;
1367 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1369 doc
: /* Return a list of the currently active keymaps.
1370 OLP if non-nil indicates that we should obey `overriding-local-map' and
1371 `overriding-terminal-local-map'. */)
1375 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1379 if (!NILP (Voverriding_local_map
))
1380 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1381 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1382 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1384 if (NILP (XCDR (keymaps
)))
1390 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1392 keymaps
= Fcons (local
, keymaps
);
1394 nmaps
= current_minor_maps (0, &maps
);
1396 for (i
= --nmaps
; i
>= 0; i
--)
1397 if (!NILP (maps
[i
]))
1398 keymaps
= Fcons (maps
[i
], keymaps
);
1400 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1402 keymaps
= Fcons (local
, keymaps
);
1408 /* GC is possible in this function if it autoloads a keymap. */
1410 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1411 doc
: /* Return the binding for command KEY in current keymaps.
1412 KEY is a string or vector, a sequence of keystrokes.
1413 The binding is probably a symbol with a function definition.
1415 Normally, `key-binding' ignores bindings for t, which act as default
1416 bindings, used when nothing else in the keymap applies; this makes it
1417 usable as a general function for probing keymaps. However, if the
1418 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1419 recognize the default bindings, just as `read-key-sequence' does.
1421 Like the normal command loop, `key-binding' will remap the command
1422 resulting from looking up KEY by looking up the command in the
1423 current keymaps. However, if the optional third argument NO-REMAP
1424 is non-nil, `key-binding' returns the unmapped command. */)
1425 (key
, accept_default
, no_remap
)
1426 Lisp_Object key
, accept_default
, no_remap
;
1428 Lisp_Object
*maps
, value
;
1430 struct gcpro gcpro1
;
1434 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1436 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1437 key
, accept_default
);
1438 if (! NILP (value
) && !INTEGERP (value
))
1441 else if (!NILP (Voverriding_local_map
))
1443 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1444 if (! NILP (value
) && !INTEGERP (value
))
1451 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1454 value
= Flookup_key (local
, key
, accept_default
);
1455 if (! NILP (value
) && !INTEGERP (value
))
1459 nmaps
= current_minor_maps (0, &maps
);
1460 /* Note that all these maps are GCPRO'd
1461 in the places where we found them. */
1463 for (i
= 0; i
< nmaps
; i
++)
1464 if (! NILP (maps
[i
]))
1466 value
= Flookup_key (maps
[i
], key
, accept_default
);
1467 if (! NILP (value
) && !INTEGERP (value
))
1471 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1474 value
= Flookup_key (local
, key
, accept_default
);
1475 if (! NILP (value
) && !INTEGERP (value
))
1480 value
= Flookup_key (current_global_map
, key
, accept_default
);
1484 if (NILP (value
) || INTEGERP (value
))
1487 /* If the result of the ordinary keymap lookup is an interactive
1488 command, look for a key binding (ie. remapping) for that command. */
1490 if (NILP (no_remap
) && SYMBOLP (value
))
1493 if (value1
= Fremap_command (value
), !NILP (value1
))
1500 /* GC is possible in this function if it autoloads a keymap. */
1502 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1503 doc
: /* Return the binding for command KEYS in current local keymap only.
1504 KEYS is a string, a sequence of keystrokes.
1505 The binding is probably a symbol with a function definition.
1507 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1508 bindings; see the description of `lookup-key' for more details about this. */)
1509 (keys
, accept_default
)
1510 Lisp_Object keys
, accept_default
;
1512 register Lisp_Object map
;
1513 map
= current_buffer
->keymap
;
1516 return Flookup_key (map
, keys
, accept_default
);
1519 /* GC is possible in this function if it autoloads a keymap. */
1521 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1522 doc
: /* Return the binding for command KEYS in current global keymap only.
1523 KEYS is a string, a sequence of keystrokes.
1524 The binding is probably a symbol with a function definition.
1525 This function's return values are the same as those of lookup-key
1528 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1529 bindings; see the description of `lookup-key' for more details about this. */)
1530 (keys
, accept_default
)
1531 Lisp_Object keys
, accept_default
;
1533 return Flookup_key (current_global_map
, keys
, accept_default
);
1536 /* GC is possible in this function if it autoloads a keymap. */
1538 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1539 doc
: /* Find the visible minor mode bindings of KEY.
1540 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1541 the symbol which names the minor mode binding KEY, and BINDING is
1542 KEY's definition in that mode. In particular, if KEY has no
1543 minor-mode bindings, return nil. If the first binding is a
1544 non-prefix, all subsequent bindings will be omitted, since they would
1545 be ignored. Similarly, the list doesn't include non-prefix bindings
1546 that come after prefix bindings.
1548 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1549 bindings; see the description of `lookup-key' for more details about this. */)
1550 (key
, accept_default
)
1551 Lisp_Object key
, accept_default
;
1553 Lisp_Object
*modes
, *maps
;
1555 Lisp_Object binding
;
1557 struct gcpro gcpro1
, gcpro2
;
1559 nmaps
= current_minor_maps (&modes
, &maps
);
1560 /* Note that all these maps are GCPRO'd
1561 in the places where we found them. */
1564 GCPRO2 (key
, binding
);
1566 for (i
= j
= 0; i
< nmaps
; i
++)
1568 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1569 && !INTEGERP (binding
))
1571 if (KEYMAPP (binding
))
1572 maps
[j
++] = Fcons (modes
[i
], binding
);
1574 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1578 return Flist (j
, maps
);
1581 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1582 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1583 A new sparse keymap is stored as COMMAND's function definition and its value.
1584 If a second optional argument MAPVAR is given, the map is stored as
1585 its value instead of as COMMAND's value; but COMMAND is still defined
1587 The third optional argument NAME, if given, supplies a menu name
1588 string for the map. This is required to use the keymap as a menu. */)
1589 (command
, mapvar
, name
)
1590 Lisp_Object command
, mapvar
, name
;
1593 map
= Fmake_sparse_keymap (name
);
1594 Ffset (command
, map
);
1598 Fset (command
, map
);
1602 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1603 doc
: /* Select KEYMAP as the global keymap. */)
1607 keymap
= get_keymap (keymap
, 1, 1);
1608 current_global_map
= keymap
;
1613 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1614 doc
: /* Select KEYMAP as the local keymap.
1615 If KEYMAP is nil, that means no local keymap. */)
1620 keymap
= get_keymap (keymap
, 1, 1);
1622 current_buffer
->keymap
= keymap
;
1627 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1628 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1631 return current_buffer
->keymap
;
1634 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1635 doc
: /* Return the current global keymap. */)
1638 return current_global_map
;
1641 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1642 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1646 int nmaps
= current_minor_maps (0, &maps
);
1648 return Flist (nmaps
, maps
);
1651 /* Help functions for describing and documenting keymaps. */
1655 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1656 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1657 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1661 cmd
= get_keyelt (cmd
, 0);
1665 tem
= get_keymap (cmd
, 0, 0);
1669 /* Ignore keymaps that are already added to maps. */
1670 tem
= Frassq (cmd
, maps
);
1673 /* If the last key in thisseq is meta-prefix-char,
1674 turn it into a meta-ized keystroke. We know
1675 that the event we're about to append is an
1676 ascii keystroke since we're processing a
1680 int meta_bit
= meta_modifier
;
1681 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1682 tem
= Fcopy_sequence (thisseq
);
1684 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1686 /* This new sequence is the same length as
1687 thisseq, so stick it in the list right
1690 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1694 tem
= append_key (thisseq
, key
);
1695 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1702 accessible_keymaps_char_table (args
, index
, cmd
)
1703 Lisp_Object args
, index
, cmd
;
1705 accessible_keymaps_1 (index
, cmd
,
1709 XINT (XCDR (XCAR (args
))));
1712 /* This function cannot GC. */
1714 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1716 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1717 Returns a list of elements of the form (KEYS . MAP), where the sequence
1718 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1719 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1720 An optional argument PREFIX, if non-nil, should be a key sequence;
1721 then the value includes only maps for prefixes that start with PREFIX. */)
1723 Lisp_Object keymap
, prefix
;
1725 Lisp_Object maps
, good_maps
, tail
;
1728 /* no need for gcpro because we don't autoload any keymaps. */
1731 prefixlen
= XINT (Flength (prefix
));
1735 /* If a prefix was specified, start with the keymap (if any) for
1736 that prefix, so we don't waste time considering other prefixes. */
1738 tem
= Flookup_key (keymap
, prefix
, Qt
);
1739 /* Flookup_key may give us nil, or a number,
1740 if the prefix is not defined in this particular map.
1741 It might even give us a list that isn't a keymap. */
1742 tem
= get_keymap (tem
, 0, 0);
1745 /* Convert PREFIX to a vector now, so that later on
1746 we don't have to deal with the possibility of a string. */
1747 if (STRINGP (prefix
))
1752 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1753 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1757 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1758 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1759 c
^= 0200 | meta_modifier
;
1760 ASET (copy
, i_before
, make_number (c
));
1764 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1770 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1771 get_keymap (keymap
, 1, 0)),
1774 /* For each map in the list maps,
1775 look at any other maps it points to,
1776 and stick them at the end if they are not already in the list.
1778 This is a breadth-first traversal, where tail is the queue of
1779 nodes, and maps accumulates a list of all nodes visited. */
1781 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1783 register Lisp_Object thisseq
, thismap
;
1785 /* Does the current sequence end in the meta-prefix-char? */
1788 thisseq
= Fcar (Fcar (tail
));
1789 thismap
= Fcdr (Fcar (tail
));
1790 last
= make_number (XINT (Flength (thisseq
)) - 1);
1791 is_metized
= (XINT (last
) >= 0
1792 /* Don't metize the last char of PREFIX. */
1793 && XINT (last
) >= prefixlen
1794 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1796 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1800 elt
= XCAR (thismap
);
1804 if (CHAR_TABLE_P (elt
))
1806 Lisp_Object indices
[3];
1808 map_char_table (accessible_keymaps_char_table
, Qnil
,
1809 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1810 Fcons (tail
, thisseq
)),
1813 else if (VECTORP (elt
))
1817 /* Vector keymap. Scan all the elements. */
1818 for (i
= 0; i
< ASIZE (elt
); i
++)
1819 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1820 maps
, tail
, thisseq
, is_metized
);
1823 else if (CONSP (elt
))
1824 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1825 maps
, tail
, thisseq
,
1826 is_metized
&& INTEGERP (XCAR (elt
)));
1834 /* Now find just the maps whose access prefixes start with PREFIX. */
1837 for (; CONSP (maps
); maps
= XCDR (maps
))
1839 Lisp_Object elt
, thisseq
;
1841 thisseq
= XCAR (elt
);
1842 /* The access prefix must be at least as long as PREFIX,
1843 and the first elements must match those of PREFIX. */
1844 if (XINT (Flength (thisseq
)) >= prefixlen
)
1847 for (i
= 0; i
< prefixlen
; i
++)
1850 XSETFASTINT (i1
, i
);
1851 if (!EQ (Faref (thisseq
, i1
), Faref (prefix
, i1
)))
1855 good_maps
= Fcons (elt
, good_maps
);
1859 return Fnreverse (good_maps
);
1862 Lisp_Object Qsingle_key_description
, Qkey_description
;
1864 /* This function cannot GC. */
1866 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1867 doc
: /* Return a pretty description of key-sequence KEYS.
1868 Control characters turn into "C-foo" sequences, meta into "M-foo"
1869 spaces are put between sequence elements, etc. */)
1876 Lisp_Object
*args
= NULL
;
1881 vector
= Fmake_vector (Flength (keys
), Qnil
);
1882 for (i
= 0, i_byte
= 0; i
< SCHARS (keys
); )
1887 FETCH_STRING_CHAR_ADVANCE (c
, keys
, i
, i_byte
);
1888 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1889 c
^= 0200 | meta_modifier
;
1890 XSETFASTINT (AREF (vector
, i_before
), c
);
1897 /* In effect, this computes
1898 (mapconcat 'single-key-description keys " ")
1899 but we shouldn't use mapconcat because it can do GC. */
1901 len
= XVECTOR (keys
)->size
;
1902 sep
= build_string (" ");
1903 /* This has one extra element at the end that we don't pass to Fconcat. */
1904 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1906 for (i
= 0; i
< len
; i
++)
1908 args
[i
* 2] = Fsingle_key_description (AREF (keys
, i
), Qnil
);
1909 args
[i
* 2 + 1] = sep
;
1912 else if (CONSP (keys
))
1914 /* In effect, this computes
1915 (mapconcat 'single-key-description keys " ")
1916 but we shouldn't use mapconcat because it can do GC. */
1918 len
= XFASTINT (Flength (keys
));
1919 sep
= build_string (" ");
1920 /* This has one extra element at the end that we don't pass to Fconcat. */
1921 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
1923 for (i
= 0; i
< len
; i
++)
1925 args
[i
* 2] = Fsingle_key_description (XCAR (keys
), Qnil
);
1926 args
[i
* 2 + 1] = sep
;
1931 keys
= wrong_type_argument (Qarrayp
, keys
);
1934 return empty_string
;
1935 return Fconcat (len
* 2 - 1, args
);
1939 push_key_description (c
, p
, force_multibyte
)
1940 register unsigned int c
;
1942 int force_multibyte
;
1946 /* Clear all the meaningless bits above the meta bit. */
1947 c
&= meta_modifier
| ~ - meta_modifier
;
1948 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
1949 | meta_modifier
| shift_modifier
| super_modifier
);
1951 if (c
& alt_modifier
)
1957 if ((c
& ctrl_modifier
) != 0
1958 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
1962 c
&= ~ctrl_modifier
;
1964 if (c
& hyper_modifier
)
1968 c
-= hyper_modifier
;
1970 if (c
& meta_modifier
)
1976 if (c
& shift_modifier
)
1980 c
-= shift_modifier
;
1982 if (c
& super_modifier
)
1986 c
-= super_modifier
;
2002 else if (c
== Ctl ('M'))
2010 /* `C-' already added above. */
2011 if (c
> 0 && c
<= Ctl ('Z'))
2030 || (NILP (current_buffer
->enable_multibyte_characters
)
2031 && SINGLE_BYTE_CHAR_P (c
)
2032 && !force_multibyte
))
2038 int valid_p
= SINGLE_BYTE_CHAR_P (c
) || char_valid_p (c
, 0);
2040 if (force_multibyte
&& valid_p
)
2042 if (SINGLE_BYTE_CHAR_P (c
))
2043 c
= unibyte_char_to_multibyte (c
);
2044 p
+= CHAR_STRING (c
, p
);
2046 else if (NILP (current_buffer
->enable_multibyte_characters
)
2051 /* The biggest character code uses 19 bits. */
2052 for (bit_offset
= 18; bit_offset
>= 0; bit_offset
-= 3)
2054 if (c
>= (1 << bit_offset
))
2055 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2059 p
+= CHAR_STRING (c
, p
);
2065 /* This function cannot GC. */
2067 DEFUN ("single-key-description", Fsingle_key_description
,
2068 Ssingle_key_description
, 1, 2, 0,
2069 doc
: /* Return a pretty description of command character KEY.
2070 Control characters turn into C-whatever, etc.
2071 Optional argument NO-ANGLES non-nil means don't put angle brackets
2072 around function keys and event symbols. */)
2074 Lisp_Object key
, no_angles
;
2076 if (CONSP (key
) && lucid_event_type_list_p (key
))
2077 key
= Fevent_convert_list (key
);
2079 key
= EVENT_HEAD (key
);
2081 if (INTEGERP (key
)) /* Normal character */
2083 unsigned int charset
, c1
, c2
;
2084 int without_bits
= XINT (key
) & ~((-1) << CHARACTERBITS
);
2086 if (SINGLE_BYTE_CHAR_P (without_bits
))
2089 SPLIT_CHAR (without_bits
, charset
, c1
, c2
);
2092 && CHARSET_DEFINED_P (charset
)
2093 && ((c1
>= 0 && c1
< 32)
2094 || (c2
>= 0 && c2
< 32)))
2096 /* Handle a generic character. */
2098 name
= CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
);
2099 CHECK_STRING (name
);
2100 return concat2 (build_string ("Character set "), name
);
2104 char tem
[KEY_DESCRIPTION_SIZE
], *end
;
2108 end
= push_key_description (XUINT (key
), tem
, 1);
2110 nchars
= multibyte_chars_in_text (tem
, nbytes
);
2111 if (nchars
== nbytes
)
2114 string
= build_string (tem
);
2117 string
= make_multibyte_string (tem
, nchars
, nbytes
);
2121 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2123 if (NILP (no_angles
))
2126 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2127 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2128 return build_string (buffer
);
2131 return Fsymbol_name (key
);
2133 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2134 return Fcopy_sequence (key
);
2136 error ("KEY must be an integer, cons, symbol, or string");
2141 push_text_char_description (c
, p
)
2142 register unsigned int c
;
2154 *p
++ = c
+ 64; /* 'A' - 1 */
2166 /* This function cannot GC. */
2168 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2169 doc
: /* Return a pretty description of file-character CHARACTER.
2170 Control characters turn into "^char", etc. */)
2172 Lisp_Object character
;
2174 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2175 unsigned char str
[6];
2178 CHECK_NUMBER (character
);
2180 c
= XINT (character
);
2181 if (!SINGLE_BYTE_CHAR_P (c
))
2183 int len
= CHAR_STRING (c
, str
);
2185 return make_multibyte_string (str
, 1, len
);
2188 *push_text_char_description (c
& 0377, str
) = 0;
2190 return build_string (str
);
2193 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2196 ascii_sequence_p (seq
)
2200 int len
= XINT (Flength (seq
));
2202 for (i
= 0; i
< len
; i
++)
2204 Lisp_Object ii
, elt
;
2206 XSETFASTINT (ii
, i
);
2207 elt
= Faref (seq
, ii
);
2210 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2218 /* where-is - finding a command in a set of keymaps. */
2220 static Lisp_Object
where_is_internal ();
2221 static Lisp_Object
where_is_internal_1 ();
2222 static void where_is_internal_2 ();
2224 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2225 Returns the first non-nil binding found in any of those maps. */
2228 shadow_lookup (shadow
, key
, flag
)
2229 Lisp_Object shadow
, key
, flag
;
2231 Lisp_Object tail
, value
;
2233 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2235 value
= Flookup_key (XCAR (tail
), key
, flag
);
2236 if (!NILP (value
) && !NATNUMP (value
))
2242 /* This function can GC if Flookup_key autoloads any keymaps. */
2245 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2246 Lisp_Object definition
, keymaps
;
2247 Lisp_Object firstonly
, noindirect
, no_remap
;
2249 Lisp_Object maps
= Qnil
;
2250 Lisp_Object found
, sequences
;
2251 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2252 /* 1 means ignore all menu bindings entirely. */
2253 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2255 /* If this command is remapped, then it has no key bindings
2257 if (NILP (no_remap
) && SYMBOLP (definition
))
2260 if (tem
= Fremap_command (definition
), !NILP (tem
))
2265 while (CONSP (found
))
2269 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2270 found
= XCDR (found
);
2273 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2277 for (; !NILP (maps
); maps
= Fcdr (maps
))
2279 /* Key sequence to reach map, and the map that it reaches */
2280 register Lisp_Object
this, map
;
2282 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2283 [M-CHAR] sequences, check if last character of the sequence
2284 is the meta-prefix char. */
2288 this = Fcar (Fcar (maps
));
2289 map
= Fcdr (Fcar (maps
));
2290 last
= make_number (XINT (Flength (this)) - 1);
2291 last_is_meta
= (XINT (last
) >= 0
2292 && EQ (Faref (this, last
), meta_prefix_char
));
2294 /* if (nomenus && !ascii_sequence_p (this)) */
2295 if (nomenus
&& XINT (last
) >= 0
2296 && !INTEGERP (Faref (this, make_number (0))))
2297 /* If no menu entries should be returned, skip over the
2298 keymaps bound to `menu-bar' and `tool-bar' and other
2299 non-ascii prefixes like `C-down-mouse-2'. */
2306 /* Because the code we want to run on each binding is rather
2307 large, we don't want to have two separate loop bodies for
2308 sparse keymap bindings and tables; we want to iterate one
2309 loop body over both keymap and vector bindings.
2311 For this reason, if Fcar (map) is a vector, we don't
2312 advance map to the next element until i indicates that we
2313 have finished off the vector. */
2314 Lisp_Object elt
, key
, binding
;
2322 /* Set key and binding to the current key and binding, and
2323 advance map and i to the next binding. */
2326 Lisp_Object sequence
;
2328 /* In a vector, look at each element. */
2329 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2331 binding
= AREF (elt
, i
);
2332 XSETFASTINT (key
, i
);
2333 sequence
= where_is_internal_1 (binding
, key
, definition
,
2335 last
, nomenus
, last_is_meta
);
2336 if (!NILP (sequence
))
2337 sequences
= Fcons (sequence
, sequences
);
2340 else if (CHAR_TABLE_P (elt
))
2342 Lisp_Object indices
[3];
2345 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2346 Qnil
), /* Result accumulator. */
2347 Fcons (Fcons (this, last
),
2348 Fcons (make_number (nomenus
),
2349 make_number (last_is_meta
))));
2350 map_char_table (where_is_internal_2
, Qnil
, elt
, args
,
2352 sequences
= XCDR (XCAR (args
));
2354 else if (CONSP (elt
))
2356 Lisp_Object sequence
;
2359 binding
= XCDR (elt
);
2361 sequence
= where_is_internal_1 (binding
, key
, definition
,
2363 last
, nomenus
, last_is_meta
);
2364 if (!NILP (sequence
))
2365 sequences
= Fcons (sequence
, sequences
);
2369 while (!NILP (sequences
))
2371 Lisp_Object sequence
, remapped
, function
;
2373 sequence
= XCAR (sequences
);
2374 sequences
= XCDR (sequences
);
2376 /* If the current sequence is a command remapping with
2377 format [remap COMMAND], find the key sequences
2378 which run COMMAND, and use those sequences instead. */
2381 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2382 && EQ (AREF (sequence
, 0), Qremap
)
2383 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2385 Lisp_Object remapped1
;
2387 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2388 if (CONSP (remapped1
))
2390 /* Verify that this key binding actually maps to the
2391 remapped command (see below). */
2392 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2394 sequence
= XCAR (remapped1
);
2395 remapped
= XCDR (remapped1
);
2396 goto record_sequence
;
2400 /* Verify that this key binding is not shadowed by another
2401 binding for the same key, before we say it exists.
2403 Mechanism: look for local definition of this key and if
2404 it is defined and does not match what we found then
2407 Either nil or number as value from Flookup_key
2409 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2413 /* It is a true unshadowed match. Record it, unless it's already
2414 been seen (as could happen when inheriting keymaps). */
2415 if (NILP (Fmember (sequence
, found
)))
2416 found
= Fcons (sequence
, found
);
2418 /* If firstonly is Qnon_ascii, then we can return the first
2419 binding we find. If firstonly is not Qnon_ascii but not
2420 nil, then we should return the first ascii-only binding
2422 if (EQ (firstonly
, Qnon_ascii
))
2423 RETURN_UNGCPRO (sequence
);
2424 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2425 RETURN_UNGCPRO (sequence
);
2427 if (CONSP (remapped
))
2429 sequence
= XCAR (remapped
);
2430 remapped
= XCDR (remapped
);
2431 goto record_sequence
;
2439 found
= Fnreverse (found
);
2441 /* firstonly may have been t, but we may have gone all the way through
2442 the keymaps without finding an all-ASCII key sequence. So just
2443 return the best we could find. */
2444 if (!NILP (firstonly
))
2445 return Fcar (found
);
2450 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2451 doc
: /* Return list of keys that invoke DEFINITION.
2452 If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2453 If KEYMAP is nil, search all the currently active keymaps.
2454 If KEYMAP is a list of keymaps, search only those keymaps.
2456 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2457 rather than a list of all possible key sequences.
2458 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2459 no matter what it is.
2460 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
2461 and entirely reject menu bindings.
2463 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2464 to other keymaps or slots. This makes it possible to search for an
2465 indirect definition itself.
2467 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2468 that invoke a command which is remapped to DEFINITION, but include the
2469 remapped command in the returned list. */)
2470 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2471 Lisp_Object definition
, keymap
;
2472 Lisp_Object firstonly
, noindirect
, no_remap
;
2474 Lisp_Object sequences
, keymaps
;
2475 /* 1 means ignore all menu bindings entirely. */
2476 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2479 /* Find the relevant keymaps. */
2480 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2482 else if (!NILP (keymap
))
2483 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2485 keymaps
= Fcurrent_active_maps (Qnil
);
2487 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2488 We don't really need to check `keymap'. */
2489 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2493 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2495 /* Check heuristic-consistency of the cache. */
2496 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2497 where_is_cache
= Qnil
;
2499 if (NILP (where_is_cache
))
2501 /* We need to create the cache. */
2502 Lisp_Object args
[2];
2503 where_is_cache
= Fmake_hash_table (0, args
);
2504 where_is_cache_keymaps
= Qt
;
2506 /* Fill in the cache. */
2507 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2508 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2511 where_is_cache_keymaps
= keymaps
;
2514 /* We want to process definitions from the last to the first.
2515 Instead of consing, copy definitions to a vector and step
2516 over that vector. */
2517 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2518 n
= XINT (Flength (sequences
));
2519 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2520 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2521 defns
[i
++] = XCAR (sequences
);
2523 /* Verify that the key bindings are not shadowed. Note that
2524 the following can GC. */
2525 GCPRO2 (definition
, keymaps
);
2528 for (i
= n
- 1; i
>= 0; --i
)
2529 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2531 if (ascii_sequence_p (defns
[i
]))
2537 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2542 /* Kill the cache so that where_is_internal_1 doesn't think
2543 we're filling it up. */
2544 where_is_cache
= Qnil
;
2545 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2551 /* This is the function that Fwhere_is_internal calls using map_char_table.
2553 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2555 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2556 Since map_char_table doesn't really use the return value from this function,
2557 we the result append to RESULT, the slot in ARGS.
2559 This function can GC because it calls where_is_internal_1 which can
2563 where_is_internal_2 (args
, key
, binding
)
2564 Lisp_Object args
, key
, binding
;
2566 Lisp_Object definition
, noindirect
, this, last
;
2567 Lisp_Object result
, sequence
;
2568 int nomenus
, last_is_meta
;
2569 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2571 GCPRO3 (args
, key
, binding
);
2572 result
= XCDR (XCAR (args
));
2573 definition
= XCAR (XCAR (XCAR (args
)));
2574 noindirect
= XCDR (XCAR (XCAR (args
)));
2575 this = XCAR (XCAR (XCDR (args
)));
2576 last
= XCDR (XCAR (XCDR (args
)));
2577 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2578 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2580 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2581 this, last
, nomenus
, last_is_meta
);
2583 if (!NILP (sequence
))
2584 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2590 /* This function cannot GC. */
2593 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2594 nomenus
, last_is_meta
)
2595 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2596 int nomenus
, last_is_meta
;
2598 Lisp_Object sequence
;
2600 /* Search through indirections unless that's not wanted. */
2601 if (NILP (noindirect
))
2602 binding
= get_keyelt (binding
, 0);
2604 /* End this iteration if this element does not match
2607 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2608 || EQ (binding
, definition
)
2609 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2610 /* Doesn't match. */
2613 /* We have found a match. Construct the key sequence where we found it. */
2614 if (INTEGERP (key
) && last_is_meta
)
2616 sequence
= Fcopy_sequence (this);
2617 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2620 sequence
= append_key (this, key
);
2622 if (!NILP (where_is_cache
))
2624 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2625 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2632 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2634 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2635 doc
: /* Insert the list of all defined keys and their definitions.
2636 The list is inserted in the current buffer, while the bindings are
2637 looked up in BUFFER.
2638 The optional argument PREFIX, if non-nil, should be a key sequence;
2639 then we display only bindings that start with that prefix.
2640 The optional argument MENUS, if non-nil, says to mention menu bindings.
2641 \(Ordinarily these are omitted from the output.) */)
2642 (buffer
, prefix
, menus
)
2643 Lisp_Object buffer
, prefix
, menus
;
2645 Lisp_Object outbuf
, shadow
;
2646 int nomenu
= NILP (menus
);
2647 register Lisp_Object start1
;
2648 struct gcpro gcpro1
;
2650 char *alternate_heading
2652 Keyboard translations:\n\n\
2653 You type Translation\n\
2654 -------- -----------\n";
2659 outbuf
= Fcurrent_buffer ();
2661 /* Report on alternates for keys. */
2662 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2665 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2666 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2668 for (c
= 0; c
< translate_len
; c
++)
2669 if (translate
[c
] != c
)
2671 char buf
[KEY_DESCRIPTION_SIZE
];
2674 if (alternate_heading
)
2676 insert_string (alternate_heading
);
2677 alternate_heading
= 0;
2680 bufend
= push_key_description (translate
[c
], buf
, 1);
2681 insert (buf
, bufend
- buf
);
2682 Findent_to (make_number (16), make_number (1));
2683 bufend
= push_key_description (c
, buf
, 1);
2684 insert (buf
, bufend
- buf
);
2692 if (!NILP (Vkey_translation_map
))
2693 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2694 "Key translations", nomenu
, 1, 0);
2697 /* Print the (major mode) local map. */
2699 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2700 start1
= current_kboard
->Voverriding_terminal_local_map
;
2701 else if (!NILP (Voverriding_local_map
))
2702 start1
= Voverriding_local_map
;
2706 describe_map_tree (start1
, 1, shadow
, prefix
,
2707 "\f\nOverriding Bindings", nomenu
, 0, 0);
2708 shadow
= Fcons (start1
, shadow
);
2712 /* Print the minor mode and major mode keymaps. */
2714 Lisp_Object
*modes
, *maps
;
2716 /* Temporarily switch to `buffer', so that we can get that buffer's
2717 minor modes correctly. */
2718 Fset_buffer (buffer
);
2720 nmaps
= current_minor_maps (&modes
, &maps
);
2721 Fset_buffer (outbuf
);
2723 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2724 XBUFFER (buffer
), Qkeymap
);
2727 describe_map_tree (start1
, 1, shadow
, prefix
,
2728 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2729 shadow
= Fcons (start1
, shadow
);
2732 /* Print the minor mode maps. */
2733 for (i
= 0; i
< nmaps
; i
++)
2735 /* The title for a minor mode keymap
2736 is constructed at run time.
2737 We let describe_map_tree do the actual insertion
2738 because it takes care of other features when doing so. */
2741 if (!SYMBOLP (modes
[i
]))
2744 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2748 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2749 SCHARS (SYMBOL_NAME (modes
[i
])));
2750 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2752 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2753 p
+= sizeof (" Minor Mode Bindings") - 1;
2756 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2757 shadow
= Fcons (maps
[i
], shadow
);
2760 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2761 XBUFFER (buffer
), Qlocal_map
);
2764 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2765 describe_map_tree (start1
, 1, shadow
, prefix
,
2766 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2768 describe_map_tree (start1
, 1, shadow
, prefix
,
2769 "\f\n`local-map' Property Bindings",
2772 shadow
= Fcons (start1
, shadow
);
2776 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2777 "\f\nGlobal Bindings", nomenu
, 0, 1);
2779 /* Print the function-key-map translations under this prefix. */
2780 if (!NILP (Vfunction_key_map
))
2781 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2782 "\f\nFunction key map translations", nomenu
, 1, 0);
2788 /* Insert a description of the key bindings in STARTMAP,
2789 followed by those of all maps reachable through STARTMAP.
2790 If PARTIAL is nonzero, omit certain "uninteresting" commands
2791 (such as `undefined').
2792 If SHADOW is non-nil, it is a list of maps;
2793 don't mention keys which would be shadowed by any of them.
2794 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2795 TITLE, if not 0, is a string to insert at the beginning.
2796 TITLE should not end with a colon or a newline; we supply that.
2797 If NOMENU is not 0, then omit menu-bar commands.
2799 If TRANSL is nonzero, the definitions are actually key translations
2800 so print strings and vectors differently.
2802 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2806 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2808 Lisp_Object startmap
, shadow
, prefix
;
2815 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2816 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2823 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2826 GCPRO3 (maps
, seen
, sub_shadows
);
2832 /* Delete from MAPS each element that is for the menu bar. */
2833 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2835 Lisp_Object elt
, prefix
, tem
;
2838 prefix
= Fcar (elt
);
2839 if (XVECTOR (prefix
)->size
>= 1)
2841 tem
= Faref (prefix
, make_number (0));
2842 if (EQ (tem
, Qmenu_bar
))
2843 maps
= Fdelq (elt
, maps
);
2848 if (!NILP (maps
) || always_title
)
2852 insert_string (title
);
2855 insert_string (" Starting With ");
2856 insert1 (Fkey_description (prefix
));
2858 insert_string (":\n");
2860 insert_string (key_heading
);
2864 for (; !NILP (maps
); maps
= Fcdr (maps
))
2866 register Lisp_Object elt
, prefix
, tail
;
2869 prefix
= Fcar (elt
);
2873 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2877 shmap
= XCAR (tail
);
2879 /* If the sequence by which we reach this keymap is zero-length,
2880 then the shadow map for this keymap is just SHADOW. */
2881 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
2882 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2884 /* If the sequence by which we reach this keymap actually has
2885 some elements, then the sequence's definition in SHADOW is
2886 what we should use. */
2889 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2890 if (INTEGERP (shmap
))
2894 /* If shmap is not nil and not a keymap,
2895 it completely shadows this map, so don't
2896 describe this map at all. */
2897 if (!NILP (shmap
) && !KEYMAPP (shmap
))
2901 sub_shadows
= Fcons (shmap
, sub_shadows
);
2904 /* Maps we have already listed in this loop shadow this map. */
2905 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
2908 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
2910 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
2913 describe_map (Fcdr (elt
), prefix
,
2914 transl
? describe_translation
: describe_command
,
2915 partial
, sub_shadows
, &seen
, nomenu
);
2921 insert_string ("\n");
2926 static int previous_description_column
;
2929 describe_command (definition
, args
)
2930 Lisp_Object definition
, args
;
2932 register Lisp_Object tem1
;
2933 int column
= (int) current_column (); /* iftc */
2934 int description_column
;
2936 /* If column 16 is no good, go to col 32;
2937 but don't push beyond that--go to next line instead. */
2941 description_column
= 32;
2943 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
2944 description_column
= 32;
2946 description_column
= 16;
2948 Findent_to (make_number (description_column
), make_number (1));
2949 previous_description_column
= description_column
;
2951 if (SYMBOLP (definition
))
2953 tem1
= SYMBOL_NAME (definition
);
2955 insert_string ("\n");
2957 else if (STRINGP (definition
) || VECTORP (definition
))
2958 insert_string ("Keyboard Macro\n");
2959 else if (KEYMAPP (definition
))
2960 insert_string ("Prefix Command\n");
2962 insert_string ("??\n");
2966 describe_translation (definition
, args
)
2967 Lisp_Object definition
, args
;
2969 register Lisp_Object tem1
;
2971 Findent_to (make_number (16), make_number (1));
2973 if (SYMBOLP (definition
))
2975 tem1
= SYMBOL_NAME (definition
);
2977 insert_string ("\n");
2979 else if (STRINGP (definition
) || VECTORP (definition
))
2981 insert1 (Fkey_description (definition
));
2982 insert_string ("\n");
2984 else if (KEYMAPP (definition
))
2985 insert_string ("Prefix Command\n");
2987 insert_string ("??\n");
2990 /* Describe the contents of map MAP, assuming that this map itself is
2991 reached by the sequence of prefix keys KEYS (a string or vector).
2992 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2995 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
2996 register Lisp_Object map
;
2998 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3004 Lisp_Object elt_prefix
;
3005 Lisp_Object tail
, definition
, event
;
3007 Lisp_Object suppress
;
3010 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3014 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
3016 /* Call Fkey_description first, to avoid GC bug for the other string. */
3017 tem
= Fkey_description (keys
);
3018 elt_prefix
= concat2 (tem
, build_string (" "));
3024 suppress
= intern ("suppress-keymap");
3026 /* This vector gets used to present single keys to Flookup_key. Since
3027 that is done once per keymap element, we don't want to cons up a
3028 fresh vector every time. */
3029 kludge
= Fmake_vector (make_number (1), Qnil
);
3032 GCPRO3 (elt_prefix
, definition
, kludge
);
3034 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3038 if (VECTORP (XCAR (tail
))
3039 || CHAR_TABLE_P (XCAR (tail
)))
3040 describe_vector (XCAR (tail
),
3041 elt_prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3043 else if (CONSP (XCAR (tail
)))
3045 event
= XCAR (XCAR (tail
));
3047 /* Ignore bindings whose "keys" are not really valid events.
3048 (We get these in the frames and buffers menu.) */
3049 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3052 if (nomenu
&& EQ (event
, Qmenu_bar
))
3055 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3057 /* Don't show undefined commands or suppressed commands. */
3058 if (NILP (definition
)) continue;
3059 if (SYMBOLP (definition
) && partial
)
3061 tem
= Fget (definition
, suppress
);
3066 /* Don't show a command that isn't really visible
3067 because a local definition of the same key shadows it. */
3069 ASET (kludge
, 0, event
);
3072 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3073 if (!NILP (tem
)) continue;
3076 tem
= Flookup_key (map
, kludge
, Qt
);
3077 if (!EQ (tem
, definition
)) continue;
3081 previous_description_column
= 0;
3086 if (!NILP (elt_prefix
))
3087 insert1 (elt_prefix
);
3089 /* THIS gets the string to describe the character EVENT. */
3090 insert1 (Fsingle_key_description (event
, Qnil
));
3092 /* Print a description of the definition of this character.
3093 elt_describer will take care of spacing out far enough
3094 for alignment purposes. */
3095 (*elt_describer
) (definition
, Qnil
);
3097 else if (EQ (XCAR (tail
), Qkeymap
))
3099 /* The same keymap might be in the structure twice, if we're
3100 using an inherited keymap. So skip anything we've already
3102 tem
= Fassq (tail
, *seen
);
3103 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), keys
)))
3105 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
3113 describe_vector_princ (elt
, fun
)
3114 Lisp_Object elt
, fun
;
3116 Findent_to (make_number (16), make_number (1));
3121 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3122 doc
: /* Insert a description of contents of VECTOR.
3123 This is text showing the elements of vector matched against indices. */)
3125 Lisp_Object vector
, describer
;
3127 int count
= SPECPDL_INDEX ();
3128 if (NILP (describer
))
3129 describer
= intern ("princ");
3130 specbind (Qstandard_output
, Fcurrent_buffer ());
3131 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3132 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3133 Qnil
, Qnil
, (int *)0, 0);
3135 return unbind_to (count
, Qnil
);
3138 /* Insert in the current buffer a description of the contents of VECTOR.
3139 We call ELT_DESCRIBER to insert the description of one value found
3142 ELT_PREFIX describes what "comes before" the keys or indices defined
3143 by this vector. This is a human-readable string whose size
3144 is not necessarily related to the situation.
3146 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3147 leads to this keymap.
3149 If the vector is a chartable, ELT_PREFIX is the vector
3150 of bytes that lead to the character set or portion of a character
3151 set described by this chartable.
3153 If PARTIAL is nonzero, it means do not mention suppressed commands
3154 (that assumes the vector is in a keymap).
3156 SHADOW is a list of keymaps that shadow this map.
3157 If it is non-nil, then we look up the key in those maps
3158 and we don't mention it now if it is defined by any of them.
3160 ENTIRE_MAP is the keymap in which this vector appears.
3161 If the definition in effect in the whole map does not match
3162 the one in this vector, we ignore this one.
3164 When describing a sub-char-table, INDICES is a list of
3165 indices at higher levels in this char-table,
3166 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3168 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3171 describe_vector (vector
, elt_prefix
, args
, elt_describer
,
3172 partial
, shadow
, entire_map
,
3173 indices
, char_table_depth
)
3174 register Lisp_Object vector
;
3175 Lisp_Object elt_prefix
, args
;
3176 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3179 Lisp_Object entire_map
;
3181 int char_table_depth
;
3183 Lisp_Object definition
;
3186 Lisp_Object suppress
;
3189 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3190 /* Range of elements to be handled. */
3192 /* A flag to tell if a leaf in this level of char-table is not a
3193 generic character (i.e. a complete multibyte character). */
3201 indices
= (int *) alloca (3 * sizeof (int));
3205 /* This vector gets used to present single keys to Flookup_key. Since
3206 that is done once per vector element, we don't want to cons up a
3207 fresh vector every time. */
3208 kludge
= Fmake_vector (make_number (1), Qnil
);
3209 GCPRO3 (elt_prefix
, definition
, kludge
);
3212 suppress
= intern ("suppress-keymap");
3214 if (CHAR_TABLE_P (vector
))
3216 if (char_table_depth
== 0)
3218 /* VECTOR is a top level char-table. */
3221 to
= CHAR_TABLE_ORDINARY_SLOTS
;
3225 /* VECTOR is a sub char-table. */
3226 if (char_table_depth
>= 3)
3227 /* A char-table is never that deep. */
3228 error ("Too deep char table");
3231 = (CHARSET_VALID_P (indices
[0])
3232 && ((CHARSET_DIMENSION (indices
[0]) == 1
3233 && char_table_depth
== 1)
3234 || char_table_depth
== 2));
3236 /* Meaningful elements are from 32th to 127th. */
3238 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
3243 /* This does the right thing for ordinary vectors. */
3247 to
= XVECTOR (vector
)->size
;
3250 for (i
= from
; i
< to
; i
++)
3254 if (CHAR_TABLE_P (vector
))
3256 if (char_table_depth
== 0 && i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
)
3259 if (i
>= CHAR_TABLE_SINGLE_BYTE_SLOTS
3260 && !CHARSET_DEFINED_P (i
- 128))
3264 = get_keyelt (XCHAR_TABLE (vector
)->contents
[i
], 0);
3267 definition
= get_keyelt (AREF (vector
, i
), 0);
3269 if (NILP (definition
)) continue;
3271 /* Don't mention suppressed commands. */
3272 if (SYMBOLP (definition
) && partial
)
3276 tem
= Fget (definition
, suppress
);
3278 if (!NILP (tem
)) continue;
3281 /* Set CHARACTER to the character this entry describes, if any.
3282 Also update *INDICES. */
3283 if (CHAR_TABLE_P (vector
))
3285 indices
[char_table_depth
] = i
;
3287 if (char_table_depth
== 0)
3290 indices
[0] = i
- 128;
3292 else if (complete_char
)
3294 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3302 /* If this binding is shadowed by some other map, ignore it. */
3303 if (!NILP (shadow
) && complete_char
)
3307 ASET (kludge
, 0, make_number (character
));
3308 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3310 if (!NILP (tem
)) continue;
3313 /* Ignore this definition if it is shadowed by an earlier
3314 one in the same keymap. */
3315 if (!NILP (entire_map
) && complete_char
)
3319 ASET (kludge
, 0, make_number (character
));
3320 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3322 if (!EQ (tem
, definition
))
3328 if (char_table_depth
== 0)
3333 /* For a sub char-table, show the depth by indentation.
3334 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3335 if (char_table_depth
> 0)
3336 insert (" ", char_table_depth
* 2); /* depth is 1 or 2. */
3338 /* Output the prefix that applies to every entry in this map. */
3339 if (!NILP (elt_prefix
))
3340 insert1 (elt_prefix
);
3342 /* Insert or describe the character this slot is for,
3343 or a description of what it is for. */
3344 if (SUB_CHAR_TABLE_P (vector
))
3347 insert_char (character
);
3350 /* We need an octal representation for this block of
3353 sprintf (work
, "(row %d)", i
);
3354 insert (work
, strlen (work
));
3357 else if (CHAR_TABLE_P (vector
))
3360 insert1 (Fsingle_key_description (make_number (character
), Qnil
));
3363 /* Print the information for this character set. */
3364 insert_string ("<");
3365 tem2
= CHARSET_TABLE_INFO (i
- 128, CHARSET_SHORT_NAME_IDX
);
3367 insert_from_string (tem2
, 0, 0, SCHARS (tem2
),
3376 insert1 (Fsingle_key_description (make_number (character
), Qnil
));
3379 /* If we find a sub char-table within a char-table,
3380 scan it recursively; it defines the details for
3381 a character set or a portion of a character set. */
3382 if (CHAR_TABLE_P (vector
) && SUB_CHAR_TABLE_P (definition
))
3385 describe_vector (definition
, elt_prefix
, args
, elt_describer
,
3386 partial
, shadow
, entire_map
,
3387 indices
, char_table_depth
+ 1);
3393 /* Find all consecutive characters or rows that have the same
3394 definition. But, for elements of a top level char table, if
3395 they are for charsets, we had better describe one by one even
3396 if they have the same definition. */
3397 if (CHAR_TABLE_P (vector
))
3401 if (char_table_depth
== 0)
3402 limit
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
3404 while (i
+ 1 < limit
3405 && (tem2
= get_keyelt (XCHAR_TABLE (vector
)->contents
[i
+ 1], 0),
3407 && !NILP (Fequal (tem2
, definition
)))
3412 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3414 && !NILP (Fequal (tem2
, definition
)))
3418 /* If we have a range of more than one character,
3419 print where the range reaches to. */
3421 if (i
!= starting_i
)
3425 if (!NILP (elt_prefix
))
3426 insert1 (elt_prefix
);
3428 if (CHAR_TABLE_P (vector
))
3430 if (char_table_depth
== 0)
3432 insert1 (Fsingle_key_description (make_number (i
), Qnil
));
3434 else if (complete_char
)
3436 indices
[char_table_depth
] = i
;
3437 character
= MAKE_CHAR (indices
[0], indices
[1], indices
[2]);
3438 insert_char (character
);
3442 /* We need an octal representation for this block of
3445 sprintf (work
, "(row %d)", i
);
3446 insert (work
, strlen (work
));
3451 insert1 (Fsingle_key_description (make_number (i
), Qnil
));
3455 /* Print a description of the definition of this character.
3456 elt_describer will take care of spacing out far enough
3457 for alignment purposes. */
3458 (*elt_describer
) (definition
, args
);
3461 /* For (sub) char-table, print `defalt' slot at last. */
3462 if (CHAR_TABLE_P (vector
) && !NILP (XCHAR_TABLE (vector
)->defalt
))
3464 insert (" ", char_table_depth
* 2);
3465 insert_string ("<<default>>");
3466 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3472 /* Apropos - finding all symbols whose names match a regexp. */
3473 static Lisp_Object apropos_predicate
;
3474 static Lisp_Object apropos_accumulate
;
3477 apropos_accum (symbol
, string
)
3478 Lisp_Object symbol
, string
;
3480 register Lisp_Object tem
;
3482 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3483 if (!NILP (tem
) && !NILP (apropos_predicate
))
3484 tem
= call1 (apropos_predicate
, symbol
);
3486 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3489 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3490 doc
: /* Show all symbols whose names contain match for REGEXP.
3491 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3492 for each symbol and a symbol is mentioned only if that returns non-nil.
3493 Return list of symbols found. */)
3495 Lisp_Object regexp
, predicate
;
3498 struct gcpro gcpro1
, gcpro2
;
3499 CHECK_STRING (regexp
);
3500 apropos_predicate
= predicate
;
3501 apropos_accumulate
= Qnil
;
3502 map_obarray (Vobarray
, apropos_accum
, regexp
);
3503 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3504 apropos_accumulate
= Qnil
;
3505 apropos_predicate
= Qnil
;
3512 Qkeymap
= intern ("keymap");
3513 staticpro (&Qkeymap
);
3514 staticpro (&apropos_predicate
);
3515 staticpro (&apropos_accumulate
);
3516 apropos_predicate
= Qnil
;
3517 apropos_accumulate
= Qnil
;
3519 /* Now we are ready to set up this property, so we can
3520 create char tables. */
3521 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3523 /* Initialize the keymaps standardly used.
3524 Each one is the value of a Lisp variable, and is also
3525 pointed to by a C variable */
3527 global_map
= Fmake_keymap (Qnil
);
3528 Fset (intern ("global-map"), global_map
);
3530 current_global_map
= global_map
;
3531 staticpro (&global_map
);
3532 staticpro (¤t_global_map
);
3534 meta_map
= Fmake_keymap (Qnil
);
3535 Fset (intern ("esc-map"), meta_map
);
3536 Ffset (intern ("ESC-prefix"), meta_map
);
3538 control_x_map
= Fmake_keymap (Qnil
);
3539 Fset (intern ("ctl-x-map"), control_x_map
);
3540 Ffset (intern ("Control-X-prefix"), control_x_map
);
3543 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3544 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3545 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3546 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3547 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3549 staticpro (&exclude_keys
);
3551 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3552 doc
: /* List of commands given new key bindings recently.
3553 This is used for internal purposes during Emacs startup;
3554 don't alter it yourself. */);
3555 Vdefine_key_rebound_commands
= Qt
;
3557 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3558 doc
: /* Default keymap to use when reading from the minibuffer. */);
3559 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3561 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3562 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3563 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3564 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3566 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3567 doc
: /* Local keymap for minibuffer input with completion. */);
3568 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3569 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3571 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3572 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3573 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3574 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3575 Vminibuffer_local_completion_map
);
3577 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3578 doc
: /* Alist of keymaps to use for minor modes.
3579 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3580 key sequences and look up bindings iff VARIABLE's value is non-nil.
3581 If two active keymaps bind the same key, the keymap appearing earlier
3582 in the list takes precedence. */);
3583 Vminor_mode_map_alist
= Qnil
;
3585 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3586 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3587 This variable is an alist just like `minor-mode-map-alist', and it is
3588 used the same way (and before `minor-mode-map-alist'); however,
3589 it is provided for major modes to bind locally. */);
3590 Vminor_mode_overriding_map_alist
= Qnil
;
3592 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3593 doc
: /* List of keymap alists to use for emulations modes.
3594 It is intended for modes or packages using multiple minor-mode keymaps.
3595 Each element is a keymap alist just like `minor-mode-map-alist', or a
3596 symbol with a variable binding which is a keymap alist, and it is used
3597 the same way. The "active" keymaps in each alist are used before
3598 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3599 Vemulation_mode_map_alists
= Qnil
;
3602 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3603 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3604 This allows Emacs to recognize function keys sent from ASCII
3605 terminals at any point in a key sequence.
3607 The `read-key-sequence' function replaces any subsequence bound by
3608 `function-key-map' with its binding. More precisely, when the active
3609 keymaps have no binding for the current key sequence but
3610 `function-key-map' binds a suffix of the sequence to a vector or string,
3611 `read-key-sequence' replaces the matching suffix with its binding, and
3612 continues with the new sequence.
3614 The events that come from bindings in `function-key-map' are not
3615 themselves looked up in `function-key-map'.
3617 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3618 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3619 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3620 key, typing `ESC O P x' would return [f1 x]. */);
3621 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3623 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3624 doc
: /* Keymap of key translations that can override keymaps.
3625 This keymap works like `function-key-map', but comes after that,
3626 and applies even for keys that have ordinary bindings. */);
3627 Vkey_translation_map
= Qnil
;
3629 Qsingle_key_description
= intern ("single-key-description");
3630 staticpro (&Qsingle_key_description
);
3632 Qkey_description
= intern ("key-description");
3633 staticpro (&Qkey_description
);
3635 Qkeymapp
= intern ("keymapp");
3636 staticpro (&Qkeymapp
);
3638 Qnon_ascii
= intern ("non-ascii");
3639 staticpro (&Qnon_ascii
);
3641 Qmenu_item
= intern ("menu-item");
3642 staticpro (&Qmenu_item
);
3644 Qremap
= intern ("remap");
3645 staticpro (&Qremap
);
3647 remap_command_vector
= Fmake_vector (make_number (2), Qremap
);
3648 staticpro (&remap_command_vector
);
3650 where_is_cache_keymaps
= Qt
;
3651 where_is_cache
= Qnil
;
3652 staticpro (&where_is_cache
);
3653 staticpro (&where_is_cache_keymaps
);
3655 defsubr (&Skeymapp
);
3656 defsubr (&Skeymap_parent
);
3657 defsubr (&Skeymap_prompt
);
3658 defsubr (&Sset_keymap_parent
);
3659 defsubr (&Smake_keymap
);
3660 defsubr (&Smake_sparse_keymap
);
3661 defsubr (&Scopy_keymap
);
3662 defsubr (&Sremap_command
);
3663 defsubr (&Skey_binding
);
3664 defsubr (&Slocal_key_binding
);
3665 defsubr (&Sglobal_key_binding
);
3666 defsubr (&Sminor_mode_key_binding
);
3667 defsubr (&Sdefine_key
);
3668 defsubr (&Slookup_key
);
3669 defsubr (&Sdefine_prefix_command
);
3670 defsubr (&Suse_global_map
);
3671 defsubr (&Suse_local_map
);
3672 defsubr (&Scurrent_local_map
);
3673 defsubr (&Scurrent_global_map
);
3674 defsubr (&Scurrent_minor_mode_maps
);
3675 defsubr (&Scurrent_active_maps
);
3676 defsubr (&Saccessible_keymaps
);
3677 defsubr (&Skey_description
);
3678 defsubr (&Sdescribe_vector
);
3679 defsubr (&Ssingle_key_description
);
3680 defsubr (&Stext_char_description
);
3681 defsubr (&Swhere_is_internal
);
3682 defsubr (&Sdescribe_buffer_bindings
);
3683 defsubr (&Sapropos_internal
);
3689 initial_define_key (global_map
, 033, "ESC-prefix");
3690 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");