* keymaps.texi (Active Keymaps): Document new POSITION argument of
[emacs.git] / src / keymap.c
blobf9071f9c6335ac180aef34047c7f7dc491bd94c3
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
25 #include <stdio.h>
26 #if HAVE_ALLOCA_H
27 # include <alloca.h>
28 #endif
29 #include "lisp.h"
30 #include "commands.h"
31 #include "buffer.h"
32 #include "charset.h"
33 #include "keyboard.h"
34 #include "termhooks.h"
35 #include "blockinput.h"
36 #include "puresize.h"
37 #include "intervals.h"
38 #include "keymap.h"
39 #include "window.h"
41 /* The number of elements in keymap vectors. */
42 #define DENSE_TABLE_SIZE (0200)
44 /* Actually allocate storage for these variables */
46 Lisp_Object current_global_map; /* Current global keymap */
48 Lisp_Object global_map; /* default global key bindings */
50 Lisp_Object meta_map; /* The keymap used for globally bound
51 ESC-prefixed default commands */
53 Lisp_Object control_x_map; /* The keymap used for globally bound
54 C-x-prefixed default commands */
56 /* was MinibufLocalMap */
57 Lisp_Object Vminibuffer_local_map;
58 /* The keymap used by the minibuf for local
59 bindings when spaces are allowed in the
60 minibuf */
62 /* was MinibufLocalNSMap */
63 Lisp_Object Vminibuffer_local_ns_map;
64 /* The keymap used by the minibuf for local
65 bindings when spaces are not encouraged
66 in the minibuf */
68 /* keymap used for minibuffers when doing completion */
69 /* was MinibufLocalCompletionMap */
70 Lisp_Object Vminibuffer_local_completion_map;
72 /* keymap used for minibuffers when doing completion in filenames */
73 Lisp_Object Vminibuffer_local_filename_completion_map;
75 /* keymap used for minibuffers when doing completion in filenames
76 with require-match*/
77 Lisp_Object Vminibuffer_local_must_match_filename_map;
79 /* keymap used for minibuffers when doing completion and require a match */
80 /* was MinibufLocalMustMatchMap */
81 Lisp_Object Vminibuffer_local_must_match_map;
83 /* Alist of minor mode variables and keymaps. */
84 Lisp_Object Vminor_mode_map_alist;
86 /* Alist of major-mode-specific overrides for
87 minor mode variables and keymaps. */
88 Lisp_Object Vminor_mode_overriding_map_alist;
90 /* List of emulation mode keymap alists. */
91 Lisp_Object Vemulation_mode_map_alists;
93 /* Keymap mapping ASCII function key sequences onto their preferred forms.
94 Initialized by the terminal-specific lisp files. See DEFVAR for more
95 documentation. */
96 Lisp_Object Vfunction_key_map;
98 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
99 Lisp_Object Vkey_translation_map;
101 /* A list of all commands given new bindings since a certain time
102 when nil was stored here.
103 This is used to speed up recomputation of menu key equivalents
104 when Emacs starts up. t means don't record anything here. */
105 Lisp_Object Vdefine_key_rebound_commands;
107 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
109 /* Alist of elements like (DEL . "\d"). */
110 static Lisp_Object exclude_keys;
112 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
113 static Lisp_Object command_remapping_vector;
115 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
116 in a string key sequence is equivalent to prefixing with this
117 character. */
118 extern Lisp_Object meta_prefix_char;
120 extern Lisp_Object Voverriding_local_map;
122 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
123 static Lisp_Object where_is_cache;
124 /* Which keymaps are reverse-stored in the cache. */
125 static Lisp_Object where_is_cache_keymaps;
127 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
128 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
130 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
131 static void describe_command P_ ((Lisp_Object, Lisp_Object));
132 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
133 static void describe_map P_ ((Lisp_Object, Lisp_Object,
134 void (*) P_ ((Lisp_Object, Lisp_Object)),
135 int, Lisp_Object, Lisp_Object*, int, int));
136 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
137 void (*) (Lisp_Object, Lisp_Object), int,
138 Lisp_Object, Lisp_Object, int *,
139 int, int, int));
140 static void silly_event_symbol_error P_ ((Lisp_Object));
142 /* Keymap object support - constructors and predicates. */
144 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
145 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
146 CHARTABLE is a char-table that holds the bindings for all characters
147 without modifiers. All entries in it are initially nil, meaning
148 "command undefined". ALIST is an assoc-list which holds bindings for
149 function keys, mouse events, and any other things that appear in the
150 input stream. Initially, ALIST is nil.
152 The optional arg STRING supplies a menu name for the keymap
153 in case you use it as a menu with `x-popup-menu'. */)
154 (string)
155 Lisp_Object string;
157 Lisp_Object tail;
158 if (!NILP (string))
159 tail = Fcons (string, Qnil);
160 else
161 tail = Qnil;
162 return Fcons (Qkeymap,
163 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
166 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
167 doc: /* Construct and return a new sparse keymap.
168 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
169 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
170 which binds the function key or mouse event SYMBOL to DEFINITION.
171 Initially the alist is nil.
173 The optional arg STRING supplies a menu name for the keymap
174 in case you use it as a menu with `x-popup-menu'. */)
175 (string)
176 Lisp_Object string;
178 if (!NILP (string))
179 return Fcons (Qkeymap, Fcons (string, Qnil));
180 return Fcons (Qkeymap, Qnil);
183 /* This function is used for installing the standard key bindings
184 at initialization time.
186 For example:
188 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
190 void
191 initial_define_key (keymap, key, defname)
192 Lisp_Object keymap;
193 int key;
194 char *defname;
196 store_in_keymap (keymap, make_number (key), intern (defname));
199 void
200 initial_define_lispy_key (keymap, keyname, defname)
201 Lisp_Object keymap;
202 char *keyname;
203 char *defname;
205 store_in_keymap (keymap, intern (keyname), intern (defname));
208 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
209 doc: /* Return t if OBJECT is a keymap.
211 A keymap is a list (keymap . ALIST),
212 or a symbol whose function definition is itself a keymap.
213 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
214 a vector of densely packed bindings for small character codes
215 is also allowed as an element. */)
216 (object)
217 Lisp_Object object;
219 return (KEYMAPP (object) ? Qt : Qnil);
222 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
223 doc: /* Return the prompt-string of a keymap MAP.
224 If non-nil, the prompt is shown in the echo-area
225 when reading a key-sequence to be looked-up in this keymap. */)
226 (map)
227 Lisp_Object map;
229 map = get_keymap (map, 0, 0);
230 while (CONSP (map))
232 Lisp_Object tem = XCAR (map);
233 if (STRINGP (tem))
234 return tem;
235 map = XCDR (map);
237 return Qnil;
240 /* Check that OBJECT is a keymap (after dereferencing through any
241 symbols). If it is, return it.
243 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
244 is an autoload form, do the autoload and try again.
245 If AUTOLOAD is nonzero, callers must assume GC is possible.
247 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
248 is zero as well), return Qt.
250 ERROR controls how we respond if OBJECT isn't a keymap.
251 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
253 Note that most of the time, we don't want to pursue autoloads.
254 Functions like Faccessible_keymaps which scan entire keymap trees
255 shouldn't load every autoloaded keymap. I'm not sure about this,
256 but it seems to me that only read_key_sequence, Flookup_key, and
257 Fdefine_key should cause keymaps to be autoloaded.
259 This function can GC when AUTOLOAD is non-zero, because it calls
260 do_autoload which can GC. */
262 Lisp_Object
263 get_keymap (object, error, autoload)
264 Lisp_Object object;
265 int error, autoload;
267 Lisp_Object tem;
269 autoload_retry:
270 if (NILP (object))
271 goto end;
272 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
273 return object;
275 tem = indirect_function (object);
276 if (CONSP (tem))
278 if (EQ (XCAR (tem), Qkeymap))
279 return tem;
281 /* Should we do an autoload? Autoload forms for keymaps have
282 Qkeymap as their fifth element. */
283 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
284 && SYMBOLP (object))
286 Lisp_Object tail;
288 tail = Fnth (make_number (4), tem);
289 if (EQ (tail, Qkeymap))
291 if (autoload)
293 struct gcpro gcpro1, gcpro2;
295 GCPRO2 (tem, object);
296 do_autoload (tem, object);
297 UNGCPRO;
299 goto autoload_retry;
301 else
302 return Qt;
307 end:
308 if (error)
309 wrong_type_argument (Qkeymapp, object);
310 return Qnil;
313 /* Return the parent map of KEYMAP, or nil if it has none.
314 We assume that KEYMAP is a valid keymap. */
316 Lisp_Object
317 keymap_parent (keymap, autoload)
318 Lisp_Object keymap;
319 int autoload;
321 Lisp_Object list;
323 keymap = get_keymap (keymap, 1, autoload);
325 /* Skip past the initial element `keymap'. */
326 list = XCDR (keymap);
327 for (; CONSP (list); list = XCDR (list))
329 /* See if there is another `keymap'. */
330 if (KEYMAPP (list))
331 return list;
334 return get_keymap (list, 0, autoload);
337 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
338 doc: /* Return the parent keymap of KEYMAP. */)
339 (keymap)
340 Lisp_Object keymap;
342 return keymap_parent (keymap, 1);
345 /* Check whether MAP is one of MAPS parents. */
347 keymap_memberp (map, maps)
348 Lisp_Object map, maps;
350 if (NILP (map)) return 0;
351 while (KEYMAPP (maps) && !EQ (map, maps))
352 maps = keymap_parent (maps, 0);
353 return (EQ (map, maps));
356 /* Set the parent keymap of MAP to PARENT. */
358 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
359 doc: /* Modify KEYMAP to set its parent map to PARENT.
360 Return PARENT. PARENT should be nil or another keymap. */)
361 (keymap, parent)
362 Lisp_Object keymap, parent;
364 Lisp_Object list, prev;
365 struct gcpro gcpro1, gcpro2;
366 int i;
368 /* Force a keymap flush for the next call to where-is.
369 Since this can be called from within where-is, we don't set where_is_cache
370 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
371 be changed during where-is, while where_is_cache_keymaps is only used at
372 the very beginning of where-is and can thus be changed here without any
373 adverse effect.
374 This is a very minor correctness (rather than safety) issue. */
375 where_is_cache_keymaps = Qt;
377 GCPRO2 (keymap, parent);
378 keymap = get_keymap (keymap, 1, 1);
380 if (!NILP (parent))
382 parent = get_keymap (parent, 1, 1);
384 /* Check for cycles. */
385 if (keymap_memberp (keymap, parent))
386 error ("Cyclic keymap inheritance");
389 /* Skip past the initial element `keymap'. */
390 prev = keymap;
391 while (1)
393 list = XCDR (prev);
394 /* If there is a parent keymap here, replace it.
395 If we came to the end, add the parent in PREV. */
396 if (!CONSP (list) || KEYMAPP (list))
398 /* If we already have the right parent, return now
399 so that we avoid the loops below. */
400 if (EQ (XCDR (prev), parent))
401 RETURN_UNGCPRO (parent);
403 CHECK_IMPURE (prev);
404 XSETCDR (prev, parent);
405 break;
407 prev = list;
410 /* Scan through for submaps, and set their parents too. */
412 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
414 /* Stop the scan when we come to the parent. */
415 if (EQ (XCAR (list), Qkeymap))
416 break;
418 /* If this element holds a prefix map, deal with it. */
419 if (CONSP (XCAR (list))
420 && CONSP (XCDR (XCAR (list))))
421 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
422 XCDR (XCAR (list)));
424 if (VECTORP (XCAR (list)))
425 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
426 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
427 fix_submap_inheritance (keymap, make_number (i),
428 XVECTOR (XCAR (list))->contents[i]);
430 if (CHAR_TABLE_P (XCAR (list)))
432 Lisp_Object indices[3];
434 map_char_table (fix_submap_inheritance, Qnil,
435 XCAR (list), XCAR (list),
436 keymap, 0, indices);
440 RETURN_UNGCPRO (parent);
443 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
444 if EVENT is also a prefix in MAP's parent,
445 make sure that SUBMAP inherits that definition as its own parent. */
447 static void
448 fix_submap_inheritance (map, event, submap)
449 Lisp_Object map, event, submap;
451 Lisp_Object map_parent, parent_entry;
453 /* SUBMAP is a cons that we found as a key binding.
454 Discard the other things found in a menu key binding. */
456 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
458 /* If it isn't a keymap now, there's no work to do. */
459 if (!CONSP (submap))
460 return;
462 map_parent = keymap_parent (map, 0);
463 if (!NILP (map_parent))
464 parent_entry =
465 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
466 else
467 parent_entry = Qnil;
469 /* If MAP's parent has something other than a keymap,
470 our own submap shadows it completely. */
471 if (!CONSP (parent_entry))
472 return;
474 if (! EQ (parent_entry, submap))
476 Lisp_Object submap_parent;
477 submap_parent = submap;
478 while (1)
480 Lisp_Object tem;
482 tem = keymap_parent (submap_parent, 0);
484 if (KEYMAPP (tem))
486 if (keymap_memberp (tem, parent_entry))
487 /* Fset_keymap_parent could create a cycle. */
488 return;
489 submap_parent = tem;
491 else
492 break;
494 Fset_keymap_parent (submap_parent, parent_entry);
498 /* Look up IDX in MAP. IDX may be any sort of event.
499 Note that this does only one level of lookup; IDX must be a single
500 event, not a sequence.
502 If T_OK is non-zero, bindings for Qt are treated as default
503 bindings; any key left unmentioned by other tables and bindings is
504 given the binding of Qt.
506 If T_OK is zero, bindings for Qt are not treated specially.
508 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
510 Lisp_Object
511 access_keymap (map, idx, t_ok, noinherit, autoload)
512 Lisp_Object map;
513 Lisp_Object idx;
514 int t_ok;
515 int noinherit;
516 int autoload;
518 Lisp_Object val;
520 /* Qunbound in VAL means we have found no binding yet. */
521 val = Qunbound;
523 /* If idx is a list (some sort of mouse click, perhaps?),
524 the index we want to use is the car of the list, which
525 ought to be a symbol. */
526 idx = EVENT_HEAD (idx);
528 /* If idx is a symbol, it might have modifiers, which need to
529 be put in the canonical order. */
530 if (SYMBOLP (idx))
531 idx = reorder_modifiers (idx);
532 else if (INTEGERP (idx))
533 /* Clobber the high bits that can be present on a machine
534 with more than 24 bits of integer. */
535 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
537 /* Handle the special meta -> esc mapping. */
538 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
540 /* See if there is a meta-map. If there's none, there is
541 no binding for IDX, unless a default binding exists in MAP. */
542 struct gcpro gcpro1;
543 Lisp_Object meta_map;
544 GCPRO1 (map);
545 /* A strange value in which Meta is set would cause
546 infinite recursion. Protect against that. */
547 if (XINT (meta_prefix_char) & CHAR_META)
548 meta_prefix_char = make_number (27);
549 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
550 t_ok, noinherit, autoload),
551 0, autoload);
552 UNGCPRO;
553 if (CONSP (meta_map))
555 map = meta_map;
556 idx = make_number (XUINT (idx) & ~meta_modifier);
558 else if (t_ok)
559 /* Set IDX to t, so that we only find a default binding. */
560 idx = Qt;
561 else
562 /* We know there is no binding. */
563 return Qnil;
566 /* t_binding is where we put a default binding that applies,
567 to use in case we do not find a binding specifically
568 for this key sequence. */
570 Lisp_Object tail;
571 Lisp_Object t_binding = Qnil;
572 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
574 GCPRO4 (map, tail, idx, t_binding);
576 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
577 If it is 1, only generic-char bindings are accepted.
578 Otherwise, neither are. */
579 t_ok = t_ok ? 2 : 0;
581 for (tail = XCDR (map);
582 (CONSP (tail)
583 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
584 tail = XCDR (tail))
586 Lisp_Object binding;
588 binding = XCAR (tail);
589 if (SYMBOLP (binding))
591 /* If NOINHERIT, stop finding prefix definitions
592 after we pass a second occurrence of the `keymap' symbol. */
593 if (noinherit && EQ (binding, Qkeymap))
594 RETURN_UNGCPRO (Qnil);
596 else if (CONSP (binding))
598 Lisp_Object key = XCAR (binding);
600 if (EQ (key, idx))
601 val = XCDR (binding);
602 else if (t_ok
603 && INTEGERP (idx)
604 && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
605 && INTEGERP (key)
606 && (XINT (key) & CHAR_MODIFIER_MASK) == 0
607 && !SINGLE_BYTE_CHAR_P (XINT (idx))
608 && !SINGLE_BYTE_CHAR_P (XINT (key))
609 && CHAR_VALID_P (XINT (key), 1)
610 && !CHAR_VALID_P (XINT (key), 0)
611 && (CHAR_CHARSET (XINT (key))
612 == CHAR_CHARSET (XINT (idx))))
614 /* KEY is the generic character of the charset of IDX.
615 Use KEY's binding if there isn't a binding for IDX
616 itself. */
617 t_binding = XCDR (binding);
618 t_ok = 0;
620 else if (t_ok > 1 && EQ (key, Qt))
622 t_binding = XCDR (binding);
623 t_ok = 1;
626 else if (VECTORP (binding))
628 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
629 val = AREF (binding, XFASTINT (idx));
631 else if (CHAR_TABLE_P (binding))
633 /* Character codes with modifiers
634 are not included in a char-table.
635 All character codes without modifiers are included. */
636 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
638 val = Faref (binding, idx);
639 /* `nil' has a special meaning for char-tables, so
640 we use something else to record an explicitly
641 unbound entry. */
642 if (NILP (val))
643 val = Qunbound;
647 /* If we found a binding, clean it up and return it. */
648 if (!EQ (val, Qunbound))
650 if (EQ (val, Qt))
651 /* A Qt binding is just like an explicit nil binding
652 (i.e. it shadows any parent binding but not bindings in
653 keymaps of lower precedence). */
654 val = Qnil;
655 val = get_keyelt (val, autoload);
656 if (KEYMAPP (val))
657 fix_submap_inheritance (map, idx, val);
658 RETURN_UNGCPRO (val);
660 QUIT;
662 UNGCPRO;
663 return get_keyelt (t_binding, autoload);
667 static void
668 map_keymap_item (fun, args, key, val, data)
669 map_keymap_function_t fun;
670 Lisp_Object args, key, val;
671 void *data;
673 /* We should maybe try to detect bindings shadowed by previous
674 ones and things like that. */
675 if (EQ (val, Qt))
676 val = Qnil;
677 (*fun) (key, val, args, data);
680 static void
681 map_keymap_char_table_item (args, key, val)
682 Lisp_Object args, key, val;
684 if (!NILP (val))
686 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
687 args = XCDR (args);
688 map_keymap_item (fun, XCDR (args), key, val,
689 XSAVE_VALUE (XCAR (args))->pointer);
693 /* Call FUN for every binding in MAP.
694 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
695 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
696 void
697 map_keymap (map, fun, args, data, autoload)
698 map_keymap_function_t fun;
699 Lisp_Object map, args;
700 void *data;
701 int autoload;
703 struct gcpro gcpro1, gcpro2, gcpro3;
704 Lisp_Object tail;
706 tail = Qnil;
707 GCPRO3 (map, args, tail);
708 map = get_keymap (map, 1, autoload);
709 for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
710 CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
711 tail = XCDR (tail))
713 Lisp_Object binding = XCAR (tail);
715 if (CONSP (binding))
716 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
717 else if (VECTORP (binding))
719 /* Loop over the char values represented in the vector. */
720 int len = ASIZE (binding);
721 int c;
722 for (c = 0; c < len; c++)
724 Lisp_Object character;
725 XSETFASTINT (character, c);
726 map_keymap_item (fun, args, character, AREF (binding, c), data);
729 else if (CHAR_TABLE_P (binding))
731 Lisp_Object indices[3];
732 map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
733 Fcons (make_save_value (fun, 0),
734 Fcons (make_save_value (data, 0),
735 args)),
736 0, indices);
739 UNGCPRO;
742 static void
743 map_keymap_call (key, val, fun, dummy)
744 Lisp_Object key, val, fun;
745 void *dummy;
747 call2 (fun, key, val);
750 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
751 doc: /* Call FUNCTION once for each event binding in KEYMAP.
752 FUNCTION is called with two arguments: the event that is bound, and
753 the definition it is bound to. If the event is an integer, it may be
754 a generic character (see Info node `(elisp)Splitting Characters'), and
755 that means that all actual character events belonging to that generic
756 character are bound to the definition.
758 If KEYMAP has a parent, the parent's bindings are included as well.
759 This works recursively: if the parent has itself a parent, then the
760 grandparent's bindings are also included and so on.
761 usage: (map-keymap FUNCTION KEYMAP) */)
762 (function, keymap, sort_first)
763 Lisp_Object function, keymap, sort_first;
765 if (INTEGERP (function))
766 /* We have to stop integers early since map_keymap gives them special
767 significance. */
768 xsignal1 (Qinvalid_function, function);
769 if (! NILP (sort_first))
770 return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
772 map_keymap (keymap, map_keymap_call, function, NULL, 1);
773 return Qnil;
776 /* Given OBJECT which was found in a slot in a keymap,
777 trace indirect definitions to get the actual definition of that slot.
778 An indirect definition is a list of the form
779 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
780 and INDEX is the object to look up in KEYMAP to yield the definition.
782 Also if OBJECT has a menu string as the first element,
783 remove that. Also remove a menu help string as second element.
785 If AUTOLOAD is nonzero, load autoloadable keymaps
786 that are referred to with indirection.
788 This can GC because menu_item_eval_property calls Feval. */
790 Lisp_Object
791 get_keyelt (object, autoload)
792 Lisp_Object object;
793 int autoload;
795 while (1)
797 if (!(CONSP (object)))
798 /* This is really the value. */
799 return object;
801 /* If the keymap contents looks like (keymap ...) or (lambda ...)
802 then use itself. */
803 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
804 return object;
806 /* If the keymap contents looks like (menu-item name . DEFN)
807 or (menu-item name DEFN ...) then use DEFN.
808 This is a new format menu item. */
809 else if (EQ (XCAR (object), Qmenu_item))
811 if (CONSP (XCDR (object)))
813 Lisp_Object tem;
815 object = XCDR (XCDR (object));
816 tem = object;
817 if (CONSP (object))
818 object = XCAR (object);
820 /* If there's a `:filter FILTER', apply FILTER to the
821 menu-item's definition to get the real definition to
822 use. */
823 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
824 if (EQ (XCAR (tem), QCfilter) && autoload)
826 Lisp_Object filter;
827 filter = XCAR (XCDR (tem));
828 filter = list2 (filter, list2 (Qquote, object));
829 object = menu_item_eval_property (filter);
830 break;
833 else
834 /* Invalid keymap. */
835 return object;
838 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
839 Keymap alist elements like (CHAR MENUSTRING . DEFN)
840 will be used by HierarKey menus. */
841 else if (STRINGP (XCAR (object)))
843 object = XCDR (object);
844 /* Also remove a menu help string, if any,
845 following the menu item name. */
846 if (CONSP (object) && STRINGP (XCAR (object)))
847 object = XCDR (object);
848 /* Also remove the sublist that caches key equivalences, if any. */
849 if (CONSP (object) && CONSP (XCAR (object)))
851 Lisp_Object carcar;
852 carcar = XCAR (XCAR (object));
853 if (NILP (carcar) || VECTORP (carcar))
854 object = XCDR (object);
858 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
859 else
861 struct gcpro gcpro1;
862 Lisp_Object map;
863 GCPRO1 (object);
864 map = get_keymap (Fcar_safe (object), 0, autoload);
865 UNGCPRO;
866 return (!CONSP (map) ? object /* Invalid keymap */
867 : access_keymap (map, Fcdr (object), 0, 0, autoload));
872 static Lisp_Object
873 store_in_keymap (keymap, idx, def)
874 Lisp_Object keymap;
875 register Lisp_Object idx;
876 Lisp_Object def;
878 /* Flush any reverse-map cache. */
879 where_is_cache = Qnil;
880 where_is_cache_keymaps = Qt;
882 /* If we are preparing to dump, and DEF is a menu element
883 with a menu item indicator, copy it to ensure it is not pure. */
884 if (CONSP (def) && PURE_P (def)
885 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
886 def = Fcons (XCAR (def), XCDR (def));
888 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
889 error ("attempt to define a key in a non-keymap");
891 /* If idx is a list (some sort of mouse click, perhaps?),
892 the index we want to use is the car of the list, which
893 ought to be a symbol. */
894 idx = EVENT_HEAD (idx);
896 /* If idx is a symbol, it might have modifiers, which need to
897 be put in the canonical order. */
898 if (SYMBOLP (idx))
899 idx = reorder_modifiers (idx);
900 else if (INTEGERP (idx))
901 /* Clobber the high bits that can be present on a machine
902 with more than 24 bits of integer. */
903 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
905 /* Scan the keymap for a binding of idx. */
907 Lisp_Object tail;
909 /* The cons after which we should insert new bindings. If the
910 keymap has a table element, we record its position here, so new
911 bindings will go after it; this way, the table will stay
912 towards the front of the alist and character lookups in dense
913 keymaps will remain fast. Otherwise, this just points at the
914 front of the keymap. */
915 Lisp_Object insertion_point;
917 insertion_point = keymap;
918 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
920 Lisp_Object elt;
922 elt = XCAR (tail);
923 if (VECTORP (elt))
925 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
927 CHECK_IMPURE (elt);
928 ASET (elt, XFASTINT (idx), def);
929 return def;
931 insertion_point = tail;
933 else if (CHAR_TABLE_P (elt))
935 /* Character codes with modifiers
936 are not included in a char-table.
937 All character codes without modifiers are included. */
938 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
940 Faset (elt, idx,
941 /* `nil' has a special meaning for char-tables, so
942 we use something else to record an explicitly
943 unbound entry. */
944 NILP (def) ? Qt : def);
945 return def;
947 insertion_point = tail;
949 else if (CONSP (elt))
951 if (EQ (idx, XCAR (elt)))
953 CHECK_IMPURE (elt);
954 XSETCDR (elt, def);
955 return def;
958 else if (EQ (elt, Qkeymap))
959 /* If we find a 'keymap' symbol in the spine of KEYMAP,
960 then we must have found the start of a second keymap
961 being used as the tail of KEYMAP, and a binding for IDX
962 should be inserted before it. */
963 goto keymap_end;
965 QUIT;
968 keymap_end:
969 /* We have scanned the entire keymap, and not found a binding for
970 IDX. Let's add one. */
971 CHECK_IMPURE (insertion_point);
972 XSETCDR (insertion_point,
973 Fcons (Fcons (idx, def), XCDR (insertion_point)));
976 return def;
979 EXFUN (Fcopy_keymap, 1);
981 Lisp_Object
982 copy_keymap_item (elt)
983 Lisp_Object elt;
985 Lisp_Object res, tem;
987 if (!CONSP (elt))
988 return elt;
990 res = tem = elt;
992 /* Is this a new format menu item. */
993 if (EQ (XCAR (tem), Qmenu_item))
995 /* Copy cell with menu-item marker. */
996 res = elt = Fcons (XCAR (tem), XCDR (tem));
997 tem = XCDR (elt);
998 if (CONSP (tem))
1000 /* Copy cell with menu-item name. */
1001 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1002 elt = XCDR (elt);
1003 tem = XCDR (elt);
1005 if (CONSP (tem))
1007 /* Copy cell with binding and if the binding is a keymap,
1008 copy that. */
1009 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1010 elt = XCDR (elt);
1011 tem = XCAR (elt);
1012 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1013 XSETCAR (elt, Fcopy_keymap (tem));
1014 tem = XCDR (elt);
1015 if (CONSP (tem) && CONSP (XCAR (tem)))
1016 /* Delete cache for key equivalences. */
1017 XSETCDR (elt, XCDR (tem));
1020 else
1022 /* It may be an old fomat menu item.
1023 Skip the optional menu string. */
1024 if (STRINGP (XCAR (tem)))
1026 /* Copy the cell, since copy-alist didn't go this deep. */
1027 res = elt = Fcons (XCAR (tem), XCDR (tem));
1028 tem = XCDR (elt);
1029 /* Also skip the optional menu help string. */
1030 if (CONSP (tem) && STRINGP (XCAR (tem)))
1032 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1033 elt = XCDR (elt);
1034 tem = XCDR (elt);
1036 /* There may also be a list that caches key equivalences.
1037 Just delete it for the new keymap. */
1038 if (CONSP (tem)
1039 && CONSP (XCAR (tem))
1040 && (NILP (XCAR (XCAR (tem)))
1041 || VECTORP (XCAR (XCAR (tem)))))
1043 XSETCDR (elt, XCDR (tem));
1044 tem = XCDR (tem);
1046 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1047 XSETCDR (elt, Fcopy_keymap (tem));
1049 else if (EQ (XCAR (tem), Qkeymap))
1050 res = Fcopy_keymap (elt);
1052 return res;
1055 static void
1056 copy_keymap_1 (chartable, idx, elt)
1057 Lisp_Object chartable, idx, elt;
1059 Faset (chartable, idx, copy_keymap_item (elt));
1062 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1063 doc: /* Return a copy of the keymap KEYMAP.
1064 The copy starts out with the same definitions of KEYMAP,
1065 but changing either the copy or KEYMAP does not affect the other.
1066 Any key definitions that are subkeymaps are recursively copied.
1067 However, a key definition which is a symbol whose definition is a keymap
1068 is not copied. */)
1069 (keymap)
1070 Lisp_Object keymap;
1072 register Lisp_Object copy, tail;
1073 keymap = get_keymap (keymap, 1, 0);
1074 copy = tail = Fcons (Qkeymap, Qnil);
1075 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1077 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1079 Lisp_Object elt = XCAR (keymap);
1080 if (CHAR_TABLE_P (elt))
1082 Lisp_Object indices[3];
1083 elt = Fcopy_sequence (elt);
1084 map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
1086 else if (VECTORP (elt))
1088 int i;
1089 elt = Fcopy_sequence (elt);
1090 for (i = 0; i < ASIZE (elt); i++)
1091 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1093 else if (CONSP (elt))
1094 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1095 XSETCDR (tail, Fcons (elt, Qnil));
1096 tail = XCDR (tail);
1097 keymap = XCDR (keymap);
1099 XSETCDR (tail, keymap);
1100 return copy;
1103 /* Simple Keymap mutators and accessors. */
1105 /* GC is possible in this function if it autoloads a keymap. */
1107 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1108 doc: /* In KEYMAP, define key sequence KEY as DEF.
1109 KEYMAP is a keymap.
1111 KEY is a string or a vector of symbols and characters meaning a
1112 sequence of keystrokes and events. Non-ASCII characters with codes
1113 above 127 (such as ISO Latin-1) can be included if you use a vector.
1114 Using [t] for KEY creates a default definition, which applies to any
1115 event type that has no other definition in this keymap.
1117 DEF is anything that can be a key's definition:
1118 nil (means key is undefined in this keymap),
1119 a command (a Lisp function suitable for interactive calling),
1120 a string (treated as a keyboard macro),
1121 a keymap (to define a prefix key),
1122 a symbol (when the key is looked up, the symbol will stand for its
1123 function definition, which should at that time be one of the above,
1124 or another symbol whose function definition is used, etc.),
1125 a cons (STRING . DEFN), meaning that DEFN is the definition
1126 (DEFN should be a valid definition in its own right),
1127 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1128 or an extended menu item definition.
1129 (See info node `(elisp)Extended Menu Items'.)
1131 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1132 binding is altered. If there is no binding for KEY, the new pair
1133 binding KEY to DEF is added at the front of KEYMAP. */)
1134 (keymap, key, def)
1135 Lisp_Object keymap;
1136 Lisp_Object key;
1137 Lisp_Object def;
1139 register int idx;
1140 register Lisp_Object c;
1141 register Lisp_Object cmd;
1142 int metized = 0;
1143 int meta_bit;
1144 int length;
1145 struct gcpro gcpro1, gcpro2, gcpro3;
1147 GCPRO3 (keymap, key, def);
1148 keymap = get_keymap (keymap, 1, 1);
1150 CHECK_VECTOR_OR_STRING (key);
1152 length = XFASTINT (Flength (key));
1153 if (length == 0)
1154 RETURN_UNGCPRO (Qnil);
1156 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1157 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1159 meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key)
1160 ? meta_modifier : 0x80);
1162 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1163 { /* DEF is apparently an XEmacs-style keyboard macro. */
1164 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1165 int i = ASIZE (def);
1166 while (--i >= 0)
1168 Lisp_Object c = AREF (def, i);
1169 if (CONSP (c) && lucid_event_type_list_p (c))
1170 c = Fevent_convert_list (c);
1171 ASET (tmp, i, c);
1173 def = tmp;
1176 idx = 0;
1177 while (1)
1179 c = Faref (key, make_number (idx));
1181 if (CONSP (c) && lucid_event_type_list_p (c))
1182 c = Fevent_convert_list (c);
1184 if (SYMBOLP (c))
1185 silly_event_symbol_error (c);
1187 if (INTEGERP (c)
1188 && (XINT (c) & meta_bit)
1189 && !metized)
1191 c = meta_prefix_char;
1192 metized = 1;
1194 else
1196 if (INTEGERP (c))
1197 XSETINT (c, XINT (c) & ~meta_bit);
1199 metized = 0;
1200 idx++;
1203 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1204 error ("Key sequence contains invalid event");
1206 if (idx == length)
1207 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1209 cmd = access_keymap (keymap, c, 0, 1, 1);
1211 /* If this key is undefined, make it a prefix. */
1212 if (NILP (cmd))
1213 cmd = define_as_prefix (keymap, c);
1215 keymap = get_keymap (cmd, 0, 1);
1216 if (!CONSP (keymap))
1217 /* We must use Fkey_description rather than just passing key to
1218 error; key might be a vector, not a string. */
1219 error ("Key sequence %s starts with non-prefix key %s",
1220 SDATA (Fkey_description (key, Qnil)),
1221 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1222 make_number (idx)),
1223 Qnil)));
1227 /* This function may GC (it calls Fkey_binding). */
1229 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1230 doc: /* Return the remapping for command COMMAND.
1231 Returns nil if COMMAND is not remapped (or not a symbol).
1233 If the optional argument POSITION is non-nil, it specifies a mouse
1234 position as returned by `event-start' and `event-end', and the
1235 remapping occurs in the keymaps associated with it. It can also be a
1236 number or marker, in which case the keymap properties at the specified
1237 buffer position instead of point are used. The KEYMAPS argument is
1238 ignored if POSITION is non-nil.
1240 If the optional argument KEYMAPS is non-nil, it should be a list of
1241 keymaps to search for command remapping. Otherwise, search for the
1242 remapping in all currently active keymaps. */)
1243 (command, position, keymaps)
1244 Lisp_Object command, position, keymaps;
1246 if (!SYMBOLP (command))
1247 return Qnil;
1249 ASET (command_remapping_vector, 1, command);
1251 if (NILP (keymaps))
1252 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1253 else
1255 Lisp_Object maps, binding;
1257 for (maps = keymaps; !NILP (maps); maps = Fcdr (maps))
1259 binding = Flookup_key (Fcar (maps), command_remapping_vector, Qnil);
1260 if (!NILP (binding) && !INTEGERP (binding))
1261 return binding;
1263 return Qnil;
1267 /* Value is number if KEY is too long; nil if valid but has no definition. */
1268 /* GC is possible in this function if it autoloads a keymap. */
1270 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1271 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1272 A value of nil means undefined. See doc of `define-key'
1273 for kinds of definitions.
1275 A number as value means KEY is "too long";
1276 that is, characters or symbols in it except for the last one
1277 fail to be a valid sequence of prefix characters in KEYMAP.
1278 The number is how many characters at the front of KEY
1279 it takes to reach a non-prefix key.
1281 Normally, `lookup-key' ignores bindings for t, which act as default
1282 bindings, used when nothing else in the keymap applies; this makes it
1283 usable as a general function for probing keymaps. However, if the
1284 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1285 recognize the default bindings, just as `read-key-sequence' does. */)
1286 (keymap, key, accept_default)
1287 Lisp_Object keymap;
1288 Lisp_Object key;
1289 Lisp_Object accept_default;
1291 register int idx;
1292 register Lisp_Object cmd;
1293 register Lisp_Object c;
1294 int length;
1295 int t_ok = !NILP (accept_default);
1296 struct gcpro gcpro1, gcpro2;
1298 GCPRO2 (keymap, key);
1299 keymap = get_keymap (keymap, 1, 1);
1301 CHECK_VECTOR_OR_STRING (key);
1303 length = XFASTINT (Flength (key));
1304 if (length == 0)
1305 RETURN_UNGCPRO (keymap);
1307 idx = 0;
1308 while (1)
1310 c = Faref (key, make_number (idx++));
1312 if (CONSP (c) && lucid_event_type_list_p (c))
1313 c = Fevent_convert_list (c);
1315 /* Turn the 8th bit of string chars into a meta modifier. */
1316 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1317 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1319 /* Allow string since binding for `menu-bar-select-buffer'
1320 includes the buffer name in the key sequence. */
1321 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1322 error ("Key sequence contains invalid event");
1324 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1325 if (idx == length)
1326 RETURN_UNGCPRO (cmd);
1328 keymap = get_keymap (cmd, 0, 1);
1329 if (!CONSP (keymap))
1330 RETURN_UNGCPRO (make_number (idx));
1332 QUIT;
1336 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1337 Assume that currently it does not define C at all.
1338 Return the keymap. */
1340 static Lisp_Object
1341 define_as_prefix (keymap, c)
1342 Lisp_Object keymap, c;
1344 Lisp_Object cmd;
1346 cmd = Fmake_sparse_keymap (Qnil);
1347 /* If this key is defined as a prefix in an inherited keymap,
1348 make it a prefix in this map, and make its definition
1349 inherit the other prefix definition. */
1350 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1351 store_in_keymap (keymap, c, cmd);
1353 return cmd;
1356 /* Append a key to the end of a key sequence. We always make a vector. */
1358 Lisp_Object
1359 append_key (key_sequence, key)
1360 Lisp_Object key_sequence, key;
1362 Lisp_Object args[2];
1364 args[0] = key_sequence;
1366 args[1] = Fcons (key, Qnil);
1367 return Fvconcat (2, args);
1370 /* Given a event type C which is a symbol,
1371 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1373 static void
1374 silly_event_symbol_error (c)
1375 Lisp_Object c;
1377 Lisp_Object parsed, base, name, assoc;
1378 int modifiers;
1380 parsed = parse_modifiers (c);
1381 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1382 base = XCAR (parsed);
1383 name = Fsymbol_name (base);
1384 /* This alist includes elements such as ("RET" . "\\r"). */
1385 assoc = Fassoc (name, exclude_keys);
1387 if (! NILP (assoc))
1389 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1390 char *p = new_mods;
1391 Lisp_Object keystring;
1392 if (modifiers & alt_modifier)
1393 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1394 if (modifiers & ctrl_modifier)
1395 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1396 if (modifiers & hyper_modifier)
1397 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1398 if (modifiers & meta_modifier)
1399 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1400 if (modifiers & shift_modifier)
1401 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1402 if (modifiers & super_modifier)
1403 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1404 *p = 0;
1406 c = reorder_modifiers (c);
1407 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1409 error ((modifiers & ~meta_modifier
1410 ? "To bind the key %s, use [?%s], not [%s]"
1411 : "To bind the key %s, use \"%s\", not [%s]"),
1412 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1413 SDATA (SYMBOL_NAME (c)));
1417 /* Global, local, and minor mode keymap stuff. */
1419 /* We can't put these variables inside current_minor_maps, since under
1420 some systems, static gets macro-defined to be the empty string.
1421 Ickypoo. */
1422 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1423 static int cmm_size = 0;
1425 /* Store a pointer to an array of the currently active minor modes in
1426 *modeptr, a pointer to an array of the keymaps of the currently
1427 active minor modes in *mapptr, and return the number of maps
1428 *mapptr contains.
1430 This function always returns a pointer to the same buffer, and may
1431 free or reallocate it, so if you want to keep it for a long time or
1432 hand it out to lisp code, copy it. This procedure will be called
1433 for every key sequence read, so the nice lispy approach (return a
1434 new assoclist, list, what have you) for each invocation would
1435 result in a lot of consing over time.
1437 If we used xrealloc/xmalloc and ran out of memory, they would throw
1438 back to the command loop, which would try to read a key sequence,
1439 which would call this function again, resulting in an infinite
1440 loop. Instead, we'll use realloc/malloc and silently truncate the
1441 list, let the key sequence be read, and hope some other piece of
1442 code signals the error. */
1444 current_minor_maps (modeptr, mapptr)
1445 Lisp_Object **modeptr, **mapptr;
1447 int i = 0;
1448 int list_number = 0;
1449 Lisp_Object alist, assoc, var, val;
1450 Lisp_Object emulation_alists;
1451 Lisp_Object lists[2];
1453 emulation_alists = Vemulation_mode_map_alists;
1454 lists[0] = Vminor_mode_overriding_map_alist;
1455 lists[1] = Vminor_mode_map_alist;
1457 for (list_number = 0; list_number < 2; list_number++)
1459 if (CONSP (emulation_alists))
1461 alist = XCAR (emulation_alists);
1462 emulation_alists = XCDR (emulation_alists);
1463 if (SYMBOLP (alist))
1464 alist = find_symbol_value (alist);
1465 list_number = -1;
1467 else
1468 alist = lists[list_number];
1470 for ( ; CONSP (alist); alist = XCDR (alist))
1471 if ((assoc = XCAR (alist), CONSP (assoc))
1472 && (var = XCAR (assoc), SYMBOLP (var))
1473 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1474 && !NILP (val))
1476 Lisp_Object temp;
1478 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1479 and also an entry in Vminor_mode_map_alist,
1480 ignore the latter. */
1481 if (list_number == 1)
1483 val = assq_no_quit (var, lists[0]);
1484 if (!NILP (val))
1485 continue;
1488 if (i >= cmm_size)
1490 int newsize, allocsize;
1491 Lisp_Object *newmodes, *newmaps;
1493 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1494 allocsize = newsize * sizeof *newmodes;
1496 /* Use malloc here. See the comment above this function.
1497 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1498 BLOCK_INPUT;
1499 newmodes = (Lisp_Object *) malloc (allocsize);
1500 if (newmodes)
1502 if (cmm_modes)
1504 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1505 free (cmm_modes);
1507 cmm_modes = newmodes;
1510 newmaps = (Lisp_Object *) malloc (allocsize);
1511 if (newmaps)
1513 if (cmm_maps)
1515 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1516 free (cmm_maps);
1518 cmm_maps = newmaps;
1520 UNBLOCK_INPUT;
1522 if (newmodes == NULL || newmaps == NULL)
1523 break;
1524 cmm_size = newsize;
1527 /* Get the keymap definition--or nil if it is not defined. */
1528 temp = Findirect_function (XCDR (assoc), Qt);
1529 if (!NILP (temp))
1531 cmm_modes[i] = var;
1532 cmm_maps [i] = temp;
1533 i++;
1538 if (modeptr) *modeptr = cmm_modes;
1539 if (mapptr) *mapptr = cmm_maps;
1540 return i;
1543 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1544 0, 2, 0,
1545 doc: /* Return a list of the currently active keymaps.
1546 OLP if non-nil indicates that we should obey `overriding-local-map' and
1547 `overriding-terminal-local-map'. POSITION can specify a click position
1548 like in the respective argument of `key-binding'. */)
1549 (olp, position)
1550 Lisp_Object olp, position;
1552 int count = SPECPDL_INDEX ();
1554 Lisp_Object keymaps;
1556 /* If a mouse click position is given, our variables are based on
1557 the buffer clicked on, not the current buffer. So we may have to
1558 switch the buffer here. */
1560 if (CONSP (position))
1562 Lisp_Object window;
1564 window = POSN_WINDOW (position);
1566 if (WINDOWP (window)
1567 && BUFFERP (XWINDOW (window)->buffer)
1568 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1570 /* Arrange to go back to the original buffer once we're done
1571 processing the key sequence. We don't use
1572 save_excursion_{save,restore} here, in analogy to
1573 `read-key-sequence' to avoid saving point. Maybe this
1574 would not be a problem here, but it is easier to keep
1575 things the same.
1578 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1580 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1584 keymaps = Fcons (current_global_map, Qnil);
1586 if (!NILP (olp))
1588 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1589 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1590 /* The doc said that overriding-terminal-local-map should
1591 override overriding-local-map. The code used them both,
1592 but it seems clearer to use just one. rms, jan 2005. */
1593 else if (!NILP (Voverriding_local_map))
1594 keymaps = Fcons (Voverriding_local_map, keymaps);
1596 if (NILP (XCDR (keymaps)))
1598 Lisp_Object *maps;
1599 int nmaps, i;
1601 Lisp_Object keymap, local_map;
1602 EMACS_INT pt;
1604 pt = INTEGERP (position) ? XINT (position)
1605 : MARKERP (position) ? marker_position (position)
1606 : PT;
1608 /* Get the buffer local maps, possibly overriden by text or
1609 overlay properties */
1611 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1612 keymap = get_local_map (pt, current_buffer, Qkeymap);
1614 if (CONSP (position))
1616 Lisp_Object string;
1618 /* For a mouse click, get the local text-property keymap
1619 of the place clicked on, rather than point. */
1621 if (POSN_INBUFFER_P (position))
1623 Lisp_Object pos;
1625 pos = POSN_BUFFER_POSN (position);
1626 if (INTEGERP (pos)
1627 && XINT (pos) >= BEG && XINT (pos) <= Z)
1629 local_map = get_local_map (XINT (pos),
1630 current_buffer, Qlocal_map);
1632 keymap = get_local_map (XINT (pos),
1633 current_buffer, Qkeymap);
1637 /* If on a mode line string with a local keymap,
1638 or for a click on a string, i.e. overlay string or a
1639 string displayed via the `display' property,
1640 consider `local-map' and `keymap' properties of
1641 that string. */
1643 if (string = POSN_STRING (position),
1644 (CONSP (string) && STRINGP (XCAR (string))))
1646 Lisp_Object pos, map;
1648 pos = XCDR (string);
1649 string = XCAR (string);
1650 if (INTEGERP (pos)
1651 && XINT (pos) >= 0
1652 && XINT (pos) < SCHARS (string))
1654 map = Fget_text_property (pos, Qlocal_map, string);
1655 if (!NILP (map))
1656 local_map = map;
1658 map = Fget_text_property (pos, Qkeymap, string);
1659 if (!NILP (map))
1660 keymap = map;
1666 if (!NILP (local_map))
1667 keymaps = Fcons (local_map, keymaps);
1669 /* Now put all the minor mode keymaps on the list. */
1670 nmaps = current_minor_maps (0, &maps);
1672 for (i = --nmaps; i >= 0; i--)
1673 if (!NILP (maps[i]))
1674 keymaps = Fcons (maps[i], keymaps);
1676 if (!NILP (keymap))
1677 keymaps = Fcons (keymap, keymaps);
1680 unbind_to (count, Qnil);
1682 return keymaps;
1685 /* GC is possible in this function if it autoloads a keymap. */
1687 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1688 doc: /* Return the binding for command KEY in current keymaps.
1689 KEY is a string or vector, a sequence of keystrokes.
1690 The binding is probably a symbol with a function definition.
1692 Normally, `key-binding' ignores bindings for t, which act as default
1693 bindings, used when nothing else in the keymap applies; this makes it
1694 usable as a general function for probing keymaps. However, if the
1695 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1696 recognize the default bindings, just as `read-key-sequence' does.
1698 Like the normal command loop, `key-binding' will remap the command
1699 resulting from looking up KEY by looking up the command in the
1700 current keymaps. However, if the optional third argument NO-REMAP
1701 is non-nil, `key-binding' returns the unmapped command.
1703 If KEY is a key sequence initiated with the mouse, the used keymaps
1704 will depend on the clicked mouse position with regard to the buffer
1705 and possible local keymaps on strings.
1707 If the optional argument POSITION is non-nil, it specifies a mouse
1708 position as returned by `event-start' and `event-end', and the lookup
1709 occurs in the keymaps associated with it instead of KEY. It can also
1710 be a number or marker, in which case the keymap properties at the
1711 specified buffer position instead of point are used.
1713 (key, accept_default, no_remap, position)
1714 Lisp_Object key, accept_default, no_remap, position;
1716 Lisp_Object *maps, value;
1717 int nmaps, i;
1718 struct gcpro gcpro1, gcpro2;
1719 int count = SPECPDL_INDEX ();
1721 GCPRO2 (key, position);
1723 if (NILP (position) && VECTORP (key))
1725 Lisp_Object event
1726 /* mouse events may have a symbolic prefix indicating the
1727 scrollbar or mode line */
1728 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1730 /* We are not interested in locations without event data */
1732 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1734 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1735 if (EQ (kind, Qmouse_click))
1736 position = EVENT_START (event);
1740 /* Key sequences beginning with mouse clicks
1741 are read using the keymaps of the buffer clicked on, not
1742 the current buffer. So we may have to switch the buffer
1743 here. */
1745 if (CONSP (position))
1747 Lisp_Object window;
1749 window = POSN_WINDOW (position);
1751 if (WINDOWP (window)
1752 && BUFFERP (XWINDOW (window)->buffer)
1753 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1755 /* Arrange to go back to the original buffer once we're done
1756 processing the key sequence. We don't use
1757 save_excursion_{save,restore} here, in analogy to
1758 `read-key-sequence' to avoid saving point. Maybe this
1759 would not be a problem here, but it is easier to keep
1760 things the same.
1763 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1765 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1769 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1771 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1772 key, accept_default);
1773 if (! NILP (value) && !INTEGERP (value))
1774 goto done;
1776 else if (! NILP (Voverriding_local_map))
1778 value = Flookup_key (Voverriding_local_map, key, accept_default);
1779 if (! NILP (value) && !INTEGERP (value))
1780 goto done;
1782 else
1784 Lisp_Object keymap, local_map;
1785 EMACS_INT pt;
1787 pt = INTEGERP (position) ? XINT (position)
1788 : MARKERP (position) ? marker_position (position)
1789 : PT;
1791 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1792 keymap = get_local_map (pt, current_buffer, Qkeymap);
1794 if (CONSP (position))
1796 Lisp_Object string;
1798 /* For a mouse click, get the local text-property keymap
1799 of the place clicked on, rather than point. */
1801 if (POSN_INBUFFER_P (position))
1803 Lisp_Object pos;
1805 pos = POSN_BUFFER_POSN (position);
1806 if (INTEGERP (pos)
1807 && XINT (pos) >= BEG && XINT (pos) <= Z)
1809 local_map = get_local_map (XINT (pos),
1810 current_buffer, Qlocal_map);
1812 keymap = get_local_map (XINT (pos),
1813 current_buffer, Qkeymap);
1817 /* If on a mode line string with a local keymap,
1818 or for a click on a string, i.e. overlay string or a
1819 string displayed via the `display' property,
1820 consider `local-map' and `keymap' properties of
1821 that string. */
1823 if (string = POSN_STRING (position),
1824 (CONSP (string) && STRINGP (XCAR (string))))
1826 Lisp_Object pos, map;
1828 pos = XCDR (string);
1829 string = XCAR (string);
1830 if (INTEGERP (pos)
1831 && XINT (pos) >= 0
1832 && XINT (pos) < SCHARS (string))
1834 map = Fget_text_property (pos, Qlocal_map, string);
1835 if (!NILP (map))
1836 local_map = map;
1838 map = Fget_text_property (pos, Qkeymap, string);
1839 if (!NILP (map))
1840 keymap = map;
1846 if (! NILP (keymap))
1848 value = Flookup_key (keymap, key, accept_default);
1849 if (! NILP (value) && !INTEGERP (value))
1850 goto done;
1853 nmaps = current_minor_maps (0, &maps);
1854 /* Note that all these maps are GCPRO'd
1855 in the places where we found them. */
1857 for (i = 0; i < nmaps; i++)
1858 if (! NILP (maps[i]))
1860 value = Flookup_key (maps[i], key, accept_default);
1861 if (! NILP (value) && !INTEGERP (value))
1862 goto done;
1865 if (! NILP (local_map))
1867 value = Flookup_key (local_map, key, accept_default);
1868 if (! NILP (value) && !INTEGERP (value))
1869 goto done;
1873 value = Flookup_key (current_global_map, key, accept_default);
1875 done:
1876 unbind_to (count, Qnil);
1878 UNGCPRO;
1879 if (NILP (value) || INTEGERP (value))
1880 return Qnil;
1882 /* If the result of the ordinary keymap lookup is an interactive
1883 command, look for a key binding (ie. remapping) for that command. */
1885 if (NILP (no_remap) && SYMBOLP (value))
1887 Lisp_Object value1;
1888 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1889 value = value1;
1892 return value;
1895 /* GC is possible in this function if it autoloads a keymap. */
1897 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1898 doc: /* Return the binding for command KEYS in current local keymap only.
1899 KEYS is a string or vector, a sequence of keystrokes.
1900 The binding is probably a symbol with a function definition.
1902 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1903 bindings; see the description of `lookup-key' for more details about this. */)
1904 (keys, accept_default)
1905 Lisp_Object keys, accept_default;
1907 register Lisp_Object map;
1908 map = current_buffer->keymap;
1909 if (NILP (map))
1910 return Qnil;
1911 return Flookup_key (map, keys, accept_default);
1914 /* GC is possible in this function if it autoloads a keymap. */
1916 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1917 doc: /* Return the binding for command KEYS in current global keymap only.
1918 KEYS is a string or vector, a sequence of keystrokes.
1919 The binding is probably a symbol with a function definition.
1920 This function's return values are the same as those of `lookup-key'
1921 \(which see).
1923 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1924 bindings; see the description of `lookup-key' for more details about this. */)
1925 (keys, accept_default)
1926 Lisp_Object keys, accept_default;
1928 return Flookup_key (current_global_map, keys, accept_default);
1931 /* GC is possible in this function if it autoloads a keymap. */
1933 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1934 doc: /* Find the visible minor mode bindings of KEY.
1935 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1936 the symbol which names the minor mode binding KEY, and BINDING is
1937 KEY's definition in that mode. In particular, if KEY has no
1938 minor-mode bindings, return nil. If the first binding is a
1939 non-prefix, all subsequent bindings will be omitted, since they would
1940 be ignored. Similarly, the list doesn't include non-prefix bindings
1941 that come after prefix bindings.
1943 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1944 bindings; see the description of `lookup-key' for more details about this. */)
1945 (key, accept_default)
1946 Lisp_Object key, accept_default;
1948 Lisp_Object *modes, *maps;
1949 int nmaps;
1950 Lisp_Object binding;
1951 int i, j;
1952 struct gcpro gcpro1, gcpro2;
1954 nmaps = current_minor_maps (&modes, &maps);
1955 /* Note that all these maps are GCPRO'd
1956 in the places where we found them. */
1958 binding = Qnil;
1959 GCPRO2 (key, binding);
1961 for (i = j = 0; i < nmaps; i++)
1962 if (!NILP (maps[i])
1963 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1964 && !INTEGERP (binding))
1966 if (KEYMAPP (binding))
1967 maps[j++] = Fcons (modes[i], binding);
1968 else if (j == 0)
1969 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1972 UNGCPRO;
1973 return Flist (j, maps);
1976 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1977 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1978 A new sparse keymap is stored as COMMAND's function definition and its value.
1979 If a second optional argument MAPVAR is given, the map is stored as
1980 its value instead of as COMMAND's value; but COMMAND is still defined
1981 as a function.
1982 The third optional argument NAME, if given, supplies a menu name
1983 string for the map. This is required to use the keymap as a menu.
1984 This function returns COMMAND. */)
1985 (command, mapvar, name)
1986 Lisp_Object command, mapvar, name;
1988 Lisp_Object map;
1989 map = Fmake_sparse_keymap (name);
1990 Ffset (command, map);
1991 if (!NILP (mapvar))
1992 Fset (mapvar, map);
1993 else
1994 Fset (command, map);
1995 return command;
1998 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1999 doc: /* Select KEYMAP as the global keymap. */)
2000 (keymap)
2001 Lisp_Object keymap;
2003 keymap = get_keymap (keymap, 1, 1);
2004 current_global_map = keymap;
2006 return Qnil;
2009 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2010 doc: /* Select KEYMAP as the local keymap.
2011 If KEYMAP is nil, that means no local keymap. */)
2012 (keymap)
2013 Lisp_Object keymap;
2015 if (!NILP (keymap))
2016 keymap = get_keymap (keymap, 1, 1);
2018 current_buffer->keymap = keymap;
2020 return Qnil;
2023 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2024 doc: /* Return current buffer's local keymap, or nil if it has none. */)
2027 return current_buffer->keymap;
2030 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2031 doc: /* Return the current global keymap. */)
2034 return current_global_map;
2037 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2038 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2041 Lisp_Object *maps;
2042 int nmaps = current_minor_maps (0, &maps);
2044 return Flist (nmaps, maps);
2047 /* Help functions for describing and documenting keymaps. */
2050 static void
2051 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
2052 Lisp_Object maps, tail, thisseq, key, cmd;
2053 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
2055 Lisp_Object tem;
2057 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2058 if (NILP (cmd))
2059 return;
2061 /* Look for and break cycles. */
2062 while (!NILP (tem = Frassq (cmd, maps)))
2064 Lisp_Object prefix = XCAR (tem);
2065 int lim = XINT (Flength (XCAR (tem)));
2066 if (lim <= XINT (Flength (thisseq)))
2067 { /* This keymap was already seen with a smaller prefix. */
2068 int i = 0;
2069 while (i < lim && EQ (Faref (prefix, make_number (i)),
2070 Faref (thisseq, make_number (i))))
2071 i++;
2072 if (i >= lim)
2073 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2074 return;
2076 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2077 but maybe `cmd' occurs again further down in `maps', so keep
2078 looking. */
2079 maps = XCDR (Fmemq (tem, maps));
2082 /* If the last key in thisseq is meta-prefix-char,
2083 turn it into a meta-ized keystroke. We know
2084 that the event we're about to append is an
2085 ascii keystroke since we're processing a
2086 keymap table. */
2087 if (is_metized)
2089 int meta_bit = meta_modifier;
2090 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2091 tem = Fcopy_sequence (thisseq);
2093 Faset (tem, last, make_number (XINT (key) | meta_bit));
2095 /* This new sequence is the same length as
2096 thisseq, so stick it in the list right
2097 after this one. */
2098 XSETCDR (tail,
2099 Fcons (Fcons (tem, cmd), XCDR (tail)));
2101 else
2103 tem = append_key (thisseq, key);
2104 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2108 static void
2109 accessible_keymaps_char_table (args, index, cmd)
2110 Lisp_Object args, index, cmd;
2112 accessible_keymaps_1 (index, cmd,
2113 XCAR (XCAR (args)),
2114 XCAR (XCDR (args)),
2115 XCDR (XCDR (args)),
2116 XINT (XCDR (XCAR (args))));
2119 /* This function cannot GC. */
2121 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2122 1, 2, 0,
2123 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2124 Returns a list of elements of the form (KEYS . MAP), where the sequence
2125 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2126 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2127 An optional argument PREFIX, if non-nil, should be a key sequence;
2128 then the value includes only maps for prefixes that start with PREFIX. */)
2129 (keymap, prefix)
2130 Lisp_Object keymap, prefix;
2132 Lisp_Object maps, tail;
2133 int prefixlen = 0;
2135 /* no need for gcpro because we don't autoload any keymaps. */
2137 if (!NILP (prefix))
2138 prefixlen = XINT (Flength (prefix));
2140 if (!NILP (prefix))
2142 /* If a prefix was specified, start with the keymap (if any) for
2143 that prefix, so we don't waste time considering other prefixes. */
2144 Lisp_Object tem;
2145 tem = Flookup_key (keymap, prefix, Qt);
2146 /* Flookup_key may give us nil, or a number,
2147 if the prefix is not defined in this particular map.
2148 It might even give us a list that isn't a keymap. */
2149 tem = get_keymap (tem, 0, 0);
2150 if (CONSP (tem))
2152 /* Convert PREFIX to a vector now, so that later on
2153 we don't have to deal with the possibility of a string. */
2154 if (STRINGP (prefix))
2156 int i, i_byte, c;
2157 Lisp_Object copy;
2159 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2160 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2162 int i_before = i;
2164 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2165 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2166 c ^= 0200 | meta_modifier;
2167 ASET (copy, i_before, make_number (c));
2169 prefix = copy;
2171 maps = Fcons (Fcons (prefix, tem), Qnil);
2173 else
2174 return Qnil;
2176 else
2177 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2178 get_keymap (keymap, 1, 0)),
2179 Qnil);
2181 /* For each map in the list maps,
2182 look at any other maps it points to,
2183 and stick them at the end if they are not already in the list.
2185 This is a breadth-first traversal, where tail is the queue of
2186 nodes, and maps accumulates a list of all nodes visited. */
2188 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2190 register Lisp_Object thisseq, thismap;
2191 Lisp_Object last;
2192 /* Does the current sequence end in the meta-prefix-char? */
2193 int is_metized;
2195 thisseq = Fcar (Fcar (tail));
2196 thismap = Fcdr (Fcar (tail));
2197 last = make_number (XINT (Flength (thisseq)) - 1);
2198 is_metized = (XINT (last) >= 0
2199 /* Don't metize the last char of PREFIX. */
2200 && XINT (last) >= prefixlen
2201 && EQ (Faref (thisseq, last), meta_prefix_char));
2203 for (; CONSP (thismap); thismap = XCDR (thismap))
2205 Lisp_Object elt;
2207 elt = XCAR (thismap);
2209 QUIT;
2211 if (CHAR_TABLE_P (elt))
2213 Lisp_Object indices[3];
2215 map_char_table (accessible_keymaps_char_table, Qnil, elt,
2216 elt, Fcons (Fcons (maps, make_number (is_metized)),
2217 Fcons (tail, thisseq)),
2218 0, indices);
2220 else if (VECTORP (elt))
2222 register int i;
2224 /* Vector keymap. Scan all the elements. */
2225 for (i = 0; i < ASIZE (elt); i++)
2226 accessible_keymaps_1 (make_number (i), AREF (elt, i),
2227 maps, tail, thisseq, is_metized);
2230 else if (CONSP (elt))
2231 accessible_keymaps_1 (XCAR (elt), XCDR (elt),
2232 maps, tail, thisseq,
2233 is_metized && INTEGERP (XCAR (elt)));
2238 return maps;
2241 Lisp_Object Qsingle_key_description, Qkey_description;
2243 /* This function cannot GC. */
2245 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2246 doc: /* Return a pretty description of key-sequence KEYS.
2247 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2248 Control characters turn into "C-foo" sequences, meta into "M-foo",
2249 spaces are put between sequence elements, etc. */)
2250 (keys, prefix)
2251 Lisp_Object keys, prefix;
2253 int len = 0;
2254 int i, i_byte;
2255 Lisp_Object *args;
2256 int size = XINT (Flength (keys));
2257 Lisp_Object list;
2258 Lisp_Object sep = build_string (" ");
2259 Lisp_Object key;
2260 int add_meta = 0;
2262 if (!NILP (prefix))
2263 size += XINT (Flength (prefix));
2265 /* This has one extra element at the end that we don't pass to Fconcat. */
2266 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2268 /* In effect, this computes
2269 (mapconcat 'single-key-description keys " ")
2270 but we shouldn't use mapconcat because it can do GC. */
2272 next_list:
2273 if (!NILP (prefix))
2274 list = prefix, prefix = Qnil;
2275 else if (!NILP (keys))
2276 list = keys, keys = Qnil;
2277 else
2279 if (add_meta)
2281 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2282 len += 2;
2284 else if (len == 0)
2285 return empty_unibyte_string;
2286 return Fconcat (len - 1, args);
2289 if (STRINGP (list))
2290 size = SCHARS (list);
2291 else if (VECTORP (list))
2292 size = XVECTOR (list)->size;
2293 else if (CONSP (list))
2294 size = XINT (Flength (list));
2295 else
2296 wrong_type_argument (Qarrayp, list);
2298 i = i_byte = 0;
2300 while (i < size)
2302 if (STRINGP (list))
2304 int c;
2305 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2306 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2307 c ^= 0200 | meta_modifier;
2308 XSETFASTINT (key, c);
2310 else if (VECTORP (list))
2312 key = AREF (list, i++);
2314 else
2316 key = XCAR (list);
2317 list = XCDR (list);
2318 i++;
2321 if (add_meta)
2323 if (!INTEGERP (key)
2324 || EQ (key, meta_prefix_char)
2325 || (XINT (key) & meta_modifier))
2327 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2328 args[len++] = sep;
2329 if (EQ (key, meta_prefix_char))
2330 continue;
2332 else
2333 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2334 add_meta = 0;
2336 else if (EQ (key, meta_prefix_char))
2338 add_meta = 1;
2339 continue;
2341 args[len++] = Fsingle_key_description (key, Qnil);
2342 args[len++] = sep;
2344 goto next_list;
2348 char *
2349 push_key_description (c, p, force_multibyte)
2350 register unsigned int c;
2351 register char *p;
2352 int force_multibyte;
2354 unsigned c2;
2355 int valid_p;
2357 /* Clear all the meaningless bits above the meta bit. */
2358 c &= meta_modifier | ~ - meta_modifier;
2359 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2360 | meta_modifier | shift_modifier | super_modifier);
2362 valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2363 if (! valid_p)
2365 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2366 p += sprintf (p, "[%d]", c);
2367 return p;
2370 if (c & alt_modifier)
2372 *p++ = 'A';
2373 *p++ = '-';
2374 c -= alt_modifier;
2376 if ((c & ctrl_modifier) != 0
2377 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2379 *p++ = 'C';
2380 *p++ = '-';
2381 c &= ~ctrl_modifier;
2383 if (c & hyper_modifier)
2385 *p++ = 'H';
2386 *p++ = '-';
2387 c -= hyper_modifier;
2389 if (c & meta_modifier)
2391 *p++ = 'M';
2392 *p++ = '-';
2393 c -= meta_modifier;
2395 if (c & shift_modifier)
2397 *p++ = 'S';
2398 *p++ = '-';
2399 c -= shift_modifier;
2401 if (c & super_modifier)
2403 *p++ = 's';
2404 *p++ = '-';
2405 c -= super_modifier;
2407 if (c < 040)
2409 if (c == 033)
2411 *p++ = 'E';
2412 *p++ = 'S';
2413 *p++ = 'C';
2415 else if (c == '\t')
2417 *p++ = 'T';
2418 *p++ = 'A';
2419 *p++ = 'B';
2421 else if (c == Ctl ('M'))
2423 *p++ = 'R';
2424 *p++ = 'E';
2425 *p++ = 'T';
2427 else
2429 /* `C-' already added above. */
2430 if (c > 0 && c <= Ctl ('Z'))
2431 *p++ = c + 0140;
2432 else
2433 *p++ = c + 0100;
2436 else if (c == 0177)
2438 *p++ = 'D';
2439 *p++ = 'E';
2440 *p++ = 'L';
2442 else if (c == ' ')
2444 *p++ = 'S';
2445 *p++ = 'P';
2446 *p++ = 'C';
2448 else if (c < 128
2449 || (NILP (current_buffer->enable_multibyte_characters)
2450 && SINGLE_BYTE_CHAR_P (c)
2451 && !force_multibyte))
2453 *p++ = c;
2455 else
2457 if (force_multibyte)
2459 if (SINGLE_BYTE_CHAR_P (c))
2460 c = unibyte_char_to_multibyte (c);
2461 p += CHAR_STRING (c, p);
2463 else if (NILP (current_buffer->enable_multibyte_characters))
2465 int bit_offset;
2466 *p++ = '\\';
2467 /* The biggest character code uses 19 bits. */
2468 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2470 if (c >= (1 << bit_offset))
2471 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2474 else
2475 p += CHAR_STRING (c, p);
2478 return p;
2481 /* This function cannot GC. */
2483 DEFUN ("single-key-description", Fsingle_key_description,
2484 Ssingle_key_description, 1, 2, 0,
2485 doc: /* Return a pretty description of command character KEY.
2486 Control characters turn into C-whatever, etc.
2487 Optional argument NO-ANGLES non-nil means don't put angle brackets
2488 around function keys and event symbols. */)
2489 (key, no_angles)
2490 Lisp_Object key, no_angles;
2492 if (CONSP (key) && lucid_event_type_list_p (key))
2493 key = Fevent_convert_list (key);
2495 key = EVENT_HEAD (key);
2497 if (INTEGERP (key)) /* Normal character */
2499 unsigned int charset, c1, c2;
2500 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2502 if (SINGLE_BYTE_CHAR_P (without_bits))
2503 charset = 0;
2504 else
2505 SPLIT_CHAR (without_bits, charset, c1, c2);
2507 if (! CHAR_VALID_P (without_bits, 1))
2509 char buf[256];
2511 sprintf (buf, "Invalid char code %d", XINT (key));
2512 return build_string (buf);
2514 else if (charset
2515 && ((c1 == 0 && c2 == -1) || c2 == 0))
2517 /* Handle a generic character. */
2518 Lisp_Object name;
2519 char buf[256];
2521 name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2522 CHECK_STRING (name);
2523 if (c1 == 0)
2524 /* Only a charset is specified. */
2525 sprintf (buf, "Generic char %d: all of ", without_bits);
2526 else
2527 /* 1st code-point of 2-dimensional charset is specified. */
2528 sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2529 return concat2 (build_string (buf), name);
2531 else
2533 char tem[KEY_DESCRIPTION_SIZE], *end;
2534 int nbytes, nchars;
2535 Lisp_Object string;
2537 end = push_key_description (XUINT (key), tem, 1);
2538 nbytes = end - tem;
2539 nchars = multibyte_chars_in_text (tem, nbytes);
2540 if (nchars == nbytes)
2542 *end = '\0';
2543 string = build_string (tem);
2545 else
2546 string = make_multibyte_string (tem, nchars, nbytes);
2547 return string;
2550 else if (SYMBOLP (key)) /* Function key or event-symbol */
2552 if (NILP (no_angles))
2554 char *buffer
2555 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2556 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2557 return build_string (buffer);
2559 else
2560 return Fsymbol_name (key);
2562 else if (STRINGP (key)) /* Buffer names in the menubar. */
2563 return Fcopy_sequence (key);
2564 else
2565 error ("KEY must be an integer, cons, symbol, or string");
2566 return Qnil;
2569 char *
2570 push_text_char_description (c, p)
2571 register unsigned int c;
2572 register char *p;
2574 if (c >= 0200)
2576 *p++ = 'M';
2577 *p++ = '-';
2578 c -= 0200;
2580 if (c < 040)
2582 *p++ = '^';
2583 *p++ = c + 64; /* 'A' - 1 */
2585 else if (c == 0177)
2587 *p++ = '^';
2588 *p++ = '?';
2590 else
2591 *p++ = c;
2592 return p;
2595 /* This function cannot GC. */
2597 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2598 doc: /* Return a pretty description of file-character CHARACTER.
2599 Control characters turn into "^char", etc. This differs from
2600 `single-key-description' which turns them into "C-char".
2601 Also, this function recognizes the 2**7 bit as the Meta character,
2602 whereas `single-key-description' uses the 2**27 bit for Meta.
2603 See Info node `(elisp)Describing Characters' for examples. */)
2604 (character)
2605 Lisp_Object character;
2607 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2608 unsigned char str[6];
2609 int c;
2611 CHECK_NUMBER (character);
2613 c = XINT (character);
2614 if (!SINGLE_BYTE_CHAR_P (c))
2616 int len = CHAR_STRING (c, str);
2618 return make_multibyte_string (str, 1, len);
2621 *push_text_char_description (c & 0377, str) = 0;
2623 return build_string (str);
2626 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2627 a meta bit. */
2628 static int
2629 ascii_sequence_p (seq)
2630 Lisp_Object seq;
2632 int i;
2633 int len = XINT (Flength (seq));
2635 for (i = 0; i < len; i++)
2637 Lisp_Object ii, elt;
2639 XSETFASTINT (ii, i);
2640 elt = Faref (seq, ii);
2642 if (!INTEGERP (elt)
2643 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2644 return 0;
2647 return 1;
2651 /* where-is - finding a command in a set of keymaps. */
2653 static Lisp_Object where_is_internal ();
2654 static Lisp_Object where_is_internal_1 ();
2655 static void where_is_internal_2 ();
2657 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2658 Returns the first non-nil binding found in any of those maps. */
2660 static Lisp_Object
2661 shadow_lookup (shadow, key, flag)
2662 Lisp_Object shadow, key, flag;
2664 Lisp_Object tail, value;
2666 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2668 value = Flookup_key (XCAR (tail), key, flag);
2669 if (NATNUMP (value))
2671 value = Flookup_key (XCAR (tail),
2672 Fsubstring (key, make_number (0), value), flag);
2673 if (!NILP (value))
2674 return Qnil;
2676 else if (!NILP (value))
2677 return value;
2679 return Qnil;
2682 static Lisp_Object Vmouse_events;
2684 /* This function can GC if Flookup_key autoloads any keymaps. */
2686 static Lisp_Object
2687 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2688 Lisp_Object definition, keymaps;
2689 Lisp_Object firstonly, noindirect, no_remap;
2691 Lisp_Object maps = Qnil;
2692 Lisp_Object found, sequences;
2693 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2694 /* 1 means ignore all menu bindings entirely. */
2695 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2697 found = keymaps;
2698 while (CONSP (found))
2700 maps =
2701 nconc2 (maps,
2702 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2703 found = XCDR (found);
2706 GCPRO5 (definition, keymaps, maps, found, sequences);
2707 found = Qnil;
2708 sequences = Qnil;
2710 /* If this command is remapped, then it has no key bindings
2711 of its own. */
2712 if (NILP (no_remap)
2713 && SYMBOLP (definition)
2714 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2715 RETURN_UNGCPRO (Qnil);
2717 for (; !NILP (maps); maps = Fcdr (maps))
2719 /* Key sequence to reach map, and the map that it reaches */
2720 register Lisp_Object this, map, tem;
2722 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2723 [M-CHAR] sequences, check if last character of the sequence
2724 is the meta-prefix char. */
2725 Lisp_Object last;
2726 int last_is_meta;
2728 this = Fcar (Fcar (maps));
2729 map = Fcdr (Fcar (maps));
2730 last = make_number (XINT (Flength (this)) - 1);
2731 last_is_meta = (XINT (last) >= 0
2732 && EQ (Faref (this, last), meta_prefix_char));
2734 /* if (nomenus && !ascii_sequence_p (this)) */
2735 if (nomenus && XINT (last) >= 0
2736 && SYMBOLP (tem = Faref (this, make_number (0)))
2737 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2738 /* If no menu entries should be returned, skip over the
2739 keymaps bound to `menu-bar' and `tool-bar' and other
2740 non-ascii prefixes like `C-down-mouse-2'. */
2741 continue;
2743 QUIT;
2745 while (CONSP (map))
2747 /* Because the code we want to run on each binding is rather
2748 large, we don't want to have two separate loop bodies for
2749 sparse keymap bindings and tables; we want to iterate one
2750 loop body over both keymap and vector bindings.
2752 For this reason, if Fcar (map) is a vector, we don't
2753 advance map to the next element until i indicates that we
2754 have finished off the vector. */
2755 Lisp_Object elt, key, binding;
2756 elt = XCAR (map);
2757 map = XCDR (map);
2759 sequences = Qnil;
2761 QUIT;
2763 /* Set key and binding to the current key and binding, and
2764 advance map and i to the next binding. */
2765 if (VECTORP (elt))
2767 Lisp_Object sequence;
2768 int i;
2769 /* In a vector, look at each element. */
2770 for (i = 0; i < XVECTOR (elt)->size; i++)
2772 binding = AREF (elt, i);
2773 XSETFASTINT (key, i);
2774 sequence = where_is_internal_1 (binding, key, definition,
2775 noindirect, this,
2776 last, nomenus, last_is_meta);
2777 if (!NILP (sequence))
2778 sequences = Fcons (sequence, sequences);
2781 else if (CHAR_TABLE_P (elt))
2783 Lisp_Object indices[3];
2784 Lisp_Object args;
2786 args = Fcons (Fcons (Fcons (definition, noindirect),
2787 Qnil), /* Result accumulator. */
2788 Fcons (Fcons (this, last),
2789 Fcons (make_number (nomenus),
2790 make_number (last_is_meta))));
2791 map_char_table (where_is_internal_2, Qnil, elt, elt, args,
2792 0, indices);
2793 sequences = XCDR (XCAR (args));
2795 else if (CONSP (elt))
2797 Lisp_Object sequence;
2799 key = XCAR (elt);
2800 binding = XCDR (elt);
2802 sequence = where_is_internal_1 (binding, key, definition,
2803 noindirect, this,
2804 last, nomenus, last_is_meta);
2805 if (!NILP (sequence))
2806 sequences = Fcons (sequence, sequences);
2810 while (!NILP (sequences))
2812 Lisp_Object sequence, remapped, function;
2814 sequence = XCAR (sequences);
2815 sequences = XCDR (sequences);
2817 /* If the current sequence is a command remapping with
2818 format [remap COMMAND], find the key sequences
2819 which run COMMAND, and use those sequences instead. */
2820 remapped = Qnil;
2821 if (NILP (no_remap)
2822 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2823 && EQ (AREF (sequence, 0), Qremap)
2824 && (function = AREF (sequence, 1), SYMBOLP (function)))
2826 Lisp_Object remapped1;
2828 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2829 if (CONSP (remapped1))
2831 /* Verify that this key binding actually maps to the
2832 remapped command (see below). */
2833 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2834 continue;
2835 sequence = XCAR (remapped1);
2836 remapped = XCDR (remapped1);
2837 goto record_sequence;
2841 /* Verify that this key binding is not shadowed by another
2842 binding for the same key, before we say it exists.
2844 Mechanism: look for local definition of this key and if
2845 it is defined and does not match what we found then
2846 ignore this key.
2848 Either nil or number as value from Flookup_key
2849 means undefined. */
2850 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2851 continue;
2853 record_sequence:
2854 /* Don't annoy user with strings from a menu such as
2855 Select Paste. Change them all to "(any string)",
2856 so that there seems to be only one menu item
2857 to report. */
2858 if (! NILP (sequence))
2860 Lisp_Object tem;
2861 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2862 if (STRINGP (tem))
2863 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2864 build_string ("(any string)"));
2867 /* It is a true unshadowed match. Record it, unless it's already
2868 been seen (as could happen when inheriting keymaps). */
2869 if (NILP (Fmember (sequence, found)))
2870 found = Fcons (sequence, found);
2872 /* If firstonly is Qnon_ascii, then we can return the first
2873 binding we find. If firstonly is not Qnon_ascii but not
2874 nil, then we should return the first ascii-only binding
2875 we find. */
2876 if (EQ (firstonly, Qnon_ascii))
2877 RETURN_UNGCPRO (sequence);
2878 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2879 RETURN_UNGCPRO (sequence);
2881 if (CONSP (remapped))
2883 sequence = XCAR (remapped);
2884 remapped = XCDR (remapped);
2885 goto record_sequence;
2891 UNGCPRO;
2893 found = Fnreverse (found);
2895 /* firstonly may have been t, but we may have gone all the way through
2896 the keymaps without finding an all-ASCII key sequence. So just
2897 return the best we could find. */
2898 if (!NILP (firstonly))
2899 return Fcar (found);
2901 return found;
2904 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2905 doc: /* Return list of keys that invoke DEFINITION.
2906 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2907 If KEYMAP is nil, search all the currently active keymaps.
2908 If KEYMAP is a list of keymaps, search only those keymaps.
2910 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2911 rather than a list of all possible key sequences.
2912 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2913 no matter what it is.
2914 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2915 \(or their meta variants) and entirely reject menu bindings.
2917 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2918 to other keymaps or slots. This makes it possible to search for an
2919 indirect definition itself.
2921 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2922 that invoke a command which is remapped to DEFINITION, but include the
2923 remapped command in the returned list. */)
2924 (definition, keymap, firstonly, noindirect, no_remap)
2925 Lisp_Object definition, keymap;
2926 Lisp_Object firstonly, noindirect, no_remap;
2928 Lisp_Object sequences, keymaps;
2929 /* 1 means ignore all menu bindings entirely. */
2930 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2931 Lisp_Object result;
2933 /* Find the relevant keymaps. */
2934 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2935 keymaps = keymap;
2936 else if (!NILP (keymap))
2937 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2938 else
2939 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2941 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2942 We don't really need to check `keymap'. */
2943 if (nomenus && NILP (noindirect) && NILP (keymap))
2945 Lisp_Object *defns;
2946 int i, j, n;
2947 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2949 /* Check heuristic-consistency of the cache. */
2950 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2951 where_is_cache = Qnil;
2953 if (NILP (where_is_cache))
2955 /* We need to create the cache. */
2956 Lisp_Object args[2];
2957 where_is_cache = Fmake_hash_table (0, args);
2958 where_is_cache_keymaps = Qt;
2960 /* Fill in the cache. */
2961 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2962 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2963 UNGCPRO;
2965 where_is_cache_keymaps = keymaps;
2968 /* We want to process definitions from the last to the first.
2969 Instead of consing, copy definitions to a vector and step
2970 over that vector. */
2971 sequences = Fgethash (definition, where_is_cache, Qnil);
2972 n = XINT (Flength (sequences));
2973 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2974 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2975 defns[i++] = XCAR (sequences);
2977 /* Verify that the key bindings are not shadowed. Note that
2978 the following can GC. */
2979 GCPRO2 (definition, keymaps);
2980 result = Qnil;
2981 j = -1;
2982 for (i = n - 1; i >= 0; --i)
2983 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2985 if (ascii_sequence_p (defns[i]))
2986 break;
2987 else if (j < 0)
2988 j = i;
2991 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2992 UNGCPRO;
2994 else
2996 /* Kill the cache so that where_is_internal_1 doesn't think
2997 we're filling it up. */
2998 where_is_cache = Qnil;
2999 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
3002 return result;
3005 /* This is the function that Fwhere_is_internal calls using map_char_table.
3006 ARGS has the form
3007 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
3009 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
3010 Since map_char_table doesn't really use the return value from this function,
3011 we the result append to RESULT, the slot in ARGS.
3013 This function can GC because it calls where_is_internal_1 which can
3014 GC. */
3016 static void
3017 where_is_internal_2 (args, key, binding)
3018 Lisp_Object args, key, binding;
3020 Lisp_Object definition, noindirect, this, last;
3021 Lisp_Object result, sequence;
3022 int nomenus, last_is_meta;
3023 struct gcpro gcpro1, gcpro2, gcpro3;
3025 GCPRO3 (args, key, binding);
3026 result = XCDR (XCAR (args));
3027 definition = XCAR (XCAR (XCAR (args)));
3028 noindirect = XCDR (XCAR (XCAR (args)));
3029 this = XCAR (XCAR (XCDR (args)));
3030 last = XCDR (XCAR (XCDR (args)));
3031 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
3032 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
3034 sequence = where_is_internal_1 (binding, key, definition, noindirect,
3035 this, last, nomenus, last_is_meta);
3037 if (!NILP (sequence))
3038 XSETCDR (XCAR (args), Fcons (sequence, result));
3040 UNGCPRO;
3044 /* This function can GC because get_keyelt can. */
3046 static Lisp_Object
3047 where_is_internal_1 (binding, key, definition, noindirect, this, last,
3048 nomenus, last_is_meta)
3049 Lisp_Object binding, key, definition, noindirect, this, last;
3050 int nomenus, last_is_meta;
3052 Lisp_Object sequence;
3054 /* Search through indirections unless that's not wanted. */
3055 if (NILP (noindirect))
3056 binding = get_keyelt (binding, 0);
3058 /* End this iteration if this element does not match
3059 the target. */
3061 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
3062 || EQ (binding, definition)
3063 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
3064 /* Doesn't match. */
3065 return Qnil;
3067 /* We have found a match. Construct the key sequence where we found it. */
3068 if (INTEGERP (key) && last_is_meta)
3070 sequence = Fcopy_sequence (this);
3071 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
3073 else
3074 sequence = append_key (this, key);
3076 if (!NILP (where_is_cache))
3078 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
3079 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
3080 return Qnil;
3082 else
3083 return sequence;
3086 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
3088 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
3089 doc: /* Insert the list of all defined keys and their definitions.
3090 The list is inserted in the current buffer, while the bindings are
3091 looked up in BUFFER.
3092 The optional argument PREFIX, if non-nil, should be a key sequence;
3093 then we display only bindings that start with that prefix.
3094 The optional argument MENUS, if non-nil, says to mention menu bindings.
3095 \(Ordinarily these are omitted from the output.) */)
3096 (buffer, prefix, menus)
3097 Lisp_Object buffer, prefix, menus;
3099 Lisp_Object outbuf, shadow;
3100 int nomenu = NILP (menus);
3101 register Lisp_Object start1;
3102 struct gcpro gcpro1;
3104 char *alternate_heading
3105 = "\
3106 Keyboard translations:\n\n\
3107 You type Translation\n\
3108 -------- -----------\n";
3110 CHECK_BUFFER (buffer);
3112 shadow = Qnil;
3113 GCPRO1 (shadow);
3115 outbuf = Fcurrent_buffer ();
3117 /* Report on alternates for keys. */
3118 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
3120 int c;
3121 const unsigned char *translate = SDATA (Vkeyboard_translate_table);
3122 int translate_len = SCHARS (Vkeyboard_translate_table);
3124 for (c = 0; c < translate_len; c++)
3125 if (translate[c] != c)
3127 char buf[KEY_DESCRIPTION_SIZE];
3128 char *bufend;
3130 if (alternate_heading)
3132 insert_string (alternate_heading);
3133 alternate_heading = 0;
3136 bufend = push_key_description (translate[c], buf, 1);
3137 insert (buf, bufend - buf);
3138 Findent_to (make_number (16), make_number (1));
3139 bufend = push_key_description (c, buf, 1);
3140 insert (buf, bufend - buf);
3142 insert ("\n", 1);
3144 /* Insert calls signal_after_change which may GC. */
3145 translate = SDATA (Vkeyboard_translate_table);
3148 insert ("\n", 1);
3151 if (!NILP (Vkey_translation_map))
3152 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3153 "Key translations", nomenu, 1, 0, 0);
3156 /* Print the (major mode) local map. */
3157 start1 = Qnil;
3158 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3159 start1 = current_kboard->Voverriding_terminal_local_map;
3160 else if (!NILP (Voverriding_local_map))
3161 start1 = Voverriding_local_map;
3163 if (!NILP (start1))
3165 describe_map_tree (start1, 1, shadow, prefix,
3166 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3167 shadow = Fcons (start1, shadow);
3169 else
3171 /* Print the minor mode and major mode keymaps. */
3172 int i, nmaps;
3173 Lisp_Object *modes, *maps;
3175 /* Temporarily switch to `buffer', so that we can get that buffer's
3176 minor modes correctly. */
3177 Fset_buffer (buffer);
3179 nmaps = current_minor_maps (&modes, &maps);
3180 Fset_buffer (outbuf);
3182 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3183 XBUFFER (buffer), Qkeymap);
3184 if (!NILP (start1))
3186 describe_map_tree (start1, 1, shadow, prefix,
3187 "\f\n`keymap' Property Bindings", nomenu,
3188 0, 0, 0);
3189 shadow = Fcons (start1, shadow);
3192 /* Print the minor mode maps. */
3193 for (i = 0; i < nmaps; i++)
3195 /* The title for a minor mode keymap
3196 is constructed at run time.
3197 We let describe_map_tree do the actual insertion
3198 because it takes care of other features when doing so. */
3199 char *title, *p;
3201 if (!SYMBOLP (modes[i]))
3202 abort();
3204 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3205 *p++ = '\f';
3206 *p++ = '\n';
3207 *p++ = '`';
3208 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3209 SCHARS (SYMBOL_NAME (modes[i])));
3210 p += SCHARS (SYMBOL_NAME (modes[i]));
3211 *p++ = '\'';
3212 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3213 p += sizeof (" Minor Mode Bindings") - 1;
3214 *p = 0;
3216 describe_map_tree (maps[i], 1, shadow, prefix,
3217 title, nomenu, 0, 0, 0);
3218 shadow = Fcons (maps[i], shadow);
3221 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3222 XBUFFER (buffer), Qlocal_map);
3223 if (!NILP (start1))
3225 if (EQ (start1, XBUFFER (buffer)->keymap))
3226 describe_map_tree (start1, 1, shadow, prefix,
3227 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3228 else
3229 describe_map_tree (start1, 1, shadow, prefix,
3230 "\f\n`local-map' Property Bindings",
3231 nomenu, 0, 0, 0);
3233 shadow = Fcons (start1, shadow);
3237 describe_map_tree (current_global_map, 1, shadow, prefix,
3238 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3240 /* Print the function-key-map translations under this prefix. */
3241 if (!NILP (Vfunction_key_map))
3242 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
3243 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3245 UNGCPRO;
3246 return Qnil;
3249 /* Insert a description of the key bindings in STARTMAP,
3250 followed by those of all maps reachable through STARTMAP.
3251 If PARTIAL is nonzero, omit certain "uninteresting" commands
3252 (such as `undefined').
3253 If SHADOW is non-nil, it is a list of maps;
3254 don't mention keys which would be shadowed by any of them.
3255 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3256 TITLE, if not 0, is a string to insert at the beginning.
3257 TITLE should not end with a colon or a newline; we supply that.
3258 If NOMENU is not 0, then omit menu-bar commands.
3260 If TRANSL is nonzero, the definitions are actually key translations
3261 so print strings and vectors differently.
3263 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3264 to look through.
3266 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3267 don't omit it; instead, mention it but say it is shadowed. */
3269 void
3270 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3271 always_title, mention_shadow)
3272 Lisp_Object startmap, shadow, prefix;
3273 int partial;
3274 char *title;
3275 int nomenu;
3276 int transl;
3277 int always_title;
3278 int mention_shadow;
3280 Lisp_Object maps, orig_maps, seen, sub_shadows;
3281 struct gcpro gcpro1, gcpro2, gcpro3;
3282 int something = 0;
3283 char *key_heading
3284 = "\
3285 key binding\n\
3286 --- -------\n";
3288 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3289 seen = Qnil;
3290 sub_shadows = Qnil;
3291 GCPRO3 (maps, seen, sub_shadows);
3293 if (nomenu)
3295 Lisp_Object list;
3297 /* Delete from MAPS each element that is for the menu bar. */
3298 for (list = maps; !NILP (list); list = XCDR (list))
3300 Lisp_Object elt, prefix, tem;
3302 elt = Fcar (list);
3303 prefix = Fcar (elt);
3304 if (XVECTOR (prefix)->size >= 1)
3306 tem = Faref (prefix, make_number (0));
3307 if (EQ (tem, Qmenu_bar))
3308 maps = Fdelq (elt, maps);
3313 if (!NILP (maps) || always_title)
3315 if (title)
3317 insert_string (title);
3318 if (!NILP (prefix))
3320 insert_string (" Starting With ");
3321 insert1 (Fkey_description (prefix, Qnil));
3323 insert_string (":\n");
3325 insert_string (key_heading);
3326 something = 1;
3329 for (; !NILP (maps); maps = Fcdr (maps))
3331 register Lisp_Object elt, prefix, tail;
3333 elt = Fcar (maps);
3334 prefix = Fcar (elt);
3336 sub_shadows = Qnil;
3338 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3340 Lisp_Object shmap;
3342 shmap = XCAR (tail);
3344 /* If the sequence by which we reach this keymap is zero-length,
3345 then the shadow map for this keymap is just SHADOW. */
3346 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3347 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3349 /* If the sequence by which we reach this keymap actually has
3350 some elements, then the sequence's definition in SHADOW is
3351 what we should use. */
3352 else
3354 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3355 if (INTEGERP (shmap))
3356 shmap = Qnil;
3359 /* If shmap is not nil and not a keymap,
3360 it completely shadows this map, so don't
3361 describe this map at all. */
3362 if (!NILP (shmap) && !KEYMAPP (shmap))
3363 goto skip;
3365 if (!NILP (shmap))
3366 sub_shadows = Fcons (shmap, sub_shadows);
3369 /* Maps we have already listed in this loop shadow this map. */
3370 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3372 Lisp_Object tem;
3373 tem = Fequal (Fcar (XCAR (tail)), prefix);
3374 if (!NILP (tem))
3375 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3378 describe_map (Fcdr (elt), prefix,
3379 transl ? describe_translation : describe_command,
3380 partial, sub_shadows, &seen, nomenu, mention_shadow);
3382 skip: ;
3385 if (something)
3386 insert_string ("\n");
3388 UNGCPRO;
3391 static int previous_description_column;
3393 static void
3394 describe_command (definition, args)
3395 Lisp_Object definition, args;
3397 register Lisp_Object tem1;
3398 int column = (int) current_column (); /* iftc */
3399 int description_column;
3401 /* If column 16 is no good, go to col 32;
3402 but don't push beyond that--go to next line instead. */
3403 if (column > 30)
3405 insert_char ('\n');
3406 description_column = 32;
3408 else if (column > 14 || (column > 10 && previous_description_column == 32))
3409 description_column = 32;
3410 else
3411 description_column = 16;
3413 Findent_to (make_number (description_column), make_number (1));
3414 previous_description_column = description_column;
3416 if (SYMBOLP (definition))
3418 tem1 = SYMBOL_NAME (definition);
3419 insert1 (tem1);
3420 insert_string ("\n");
3422 else if (STRINGP (definition) || VECTORP (definition))
3423 insert_string ("Keyboard Macro\n");
3424 else if (KEYMAPP (definition))
3425 insert_string ("Prefix Command\n");
3426 else
3427 insert_string ("??\n");
3430 static void
3431 describe_translation (definition, args)
3432 Lisp_Object definition, args;
3434 register Lisp_Object tem1;
3436 Findent_to (make_number (16), make_number (1));
3438 if (SYMBOLP (definition))
3440 tem1 = SYMBOL_NAME (definition);
3441 insert1 (tem1);
3442 insert_string ("\n");
3444 else if (STRINGP (definition) || VECTORP (definition))
3446 insert1 (Fkey_description (definition, Qnil));
3447 insert_string ("\n");
3449 else if (KEYMAPP (definition))
3450 insert_string ("Prefix Command\n");
3451 else
3452 insert_string ("??\n");
3455 /* describe_map puts all the usable elements of a sparse keymap
3456 into an array of `struct describe_map_elt',
3457 then sorts them by the events. */
3459 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3461 /* qsort comparison function for sorting `struct describe_map_elt' by
3462 the event field. */
3464 static int
3465 describe_map_compare (aa, bb)
3466 const void *aa, *bb;
3468 const struct describe_map_elt *a = aa, *b = bb;
3469 if (INTEGERP (a->event) && INTEGERP (b->event))
3470 return ((XINT (a->event) > XINT (b->event))
3471 - (XINT (a->event) < XINT (b->event)));
3472 if (!INTEGERP (a->event) && INTEGERP (b->event))
3473 return 1;
3474 if (INTEGERP (a->event) && !INTEGERP (b->event))
3475 return -1;
3476 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3477 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3478 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3479 : 0);
3480 return 0;
3483 /* Describe the contents of map MAP, assuming that this map itself is
3484 reached by the sequence of prefix keys PREFIX (a string or vector).
3485 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3487 static void
3488 describe_map (map, prefix, elt_describer, partial, shadow,
3489 seen, nomenu, mention_shadow)
3490 register Lisp_Object map;
3491 Lisp_Object prefix;
3492 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3493 int partial;
3494 Lisp_Object shadow;
3495 Lisp_Object *seen;
3496 int nomenu;
3497 int mention_shadow;
3499 Lisp_Object tail, definition, event;
3500 Lisp_Object tem;
3501 Lisp_Object suppress;
3502 Lisp_Object kludge;
3503 int first = 1;
3504 struct gcpro gcpro1, gcpro2, gcpro3;
3506 /* These accumulate the values from sparse keymap bindings,
3507 so we can sort them and handle them in order. */
3508 int length_needed = 0;
3509 struct describe_map_elt *vect;
3510 int slots_used = 0;
3511 int i;
3513 suppress = Qnil;
3515 if (partial)
3516 suppress = intern ("suppress-keymap");
3518 /* This vector gets used to present single keys to Flookup_key. Since
3519 that is done once per keymap element, we don't want to cons up a
3520 fresh vector every time. */
3521 kludge = Fmake_vector (make_number (1), Qnil);
3522 definition = Qnil;
3524 for (tail = map; CONSP (tail); tail = XCDR (tail))
3525 length_needed++;
3527 vect = ((struct describe_map_elt *)
3528 alloca (sizeof (struct describe_map_elt) * length_needed));
3530 GCPRO3 (prefix, definition, kludge);
3532 for (tail = map; CONSP (tail); tail = XCDR (tail))
3534 QUIT;
3536 if (VECTORP (XCAR (tail))
3537 || CHAR_TABLE_P (XCAR (tail)))
3538 describe_vector (XCAR (tail),
3539 prefix, Qnil, elt_describer, partial, shadow, map,
3540 (int *)0, 0, 1, mention_shadow);
3541 else if (CONSP (XCAR (tail)))
3543 int this_shadowed = 0;
3545 event = XCAR (XCAR (tail));
3547 /* Ignore bindings whose "prefix" are not really valid events.
3548 (We get these in the frames and buffers menu.) */
3549 if (!(SYMBOLP (event) || INTEGERP (event)))
3550 continue;
3552 if (nomenu && EQ (event, Qmenu_bar))
3553 continue;
3555 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3557 /* Don't show undefined commands or suppressed commands. */
3558 if (NILP (definition)) continue;
3559 if (SYMBOLP (definition) && partial)
3561 tem = Fget (definition, suppress);
3562 if (!NILP (tem))
3563 continue;
3566 /* Don't show a command that isn't really visible
3567 because a local definition of the same key shadows it. */
3569 ASET (kludge, 0, event);
3570 if (!NILP (shadow))
3572 tem = shadow_lookup (shadow, kludge, Qt);
3573 if (!NILP (tem))
3575 /* If both bindings are keymaps, this key is a prefix key,
3576 so don't say it is shadowed. */
3577 if (KEYMAPP (definition) && KEYMAPP (tem))
3579 /* Avoid generating duplicate entries if the
3580 shadowed binding has the same definition. */
3581 else if (mention_shadow && !EQ (tem, definition))
3582 this_shadowed = 1;
3583 else
3584 continue;
3588 tem = Flookup_key (map, kludge, Qt);
3589 if (!EQ (tem, definition)) continue;
3591 vect[slots_used].event = event;
3592 vect[slots_used].definition = definition;
3593 vect[slots_used].shadowed = this_shadowed;
3594 slots_used++;
3596 else if (EQ (XCAR (tail), Qkeymap))
3598 /* The same keymap might be in the structure twice, if we're
3599 using an inherited keymap. So skip anything we've already
3600 encountered. */
3601 tem = Fassq (tail, *seen);
3602 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3603 break;
3604 *seen = Fcons (Fcons (tail, prefix), *seen);
3608 /* If we found some sparse map events, sort them. */
3610 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3611 describe_map_compare);
3613 /* Now output them in sorted order. */
3615 for (i = 0; i < slots_used; i++)
3617 Lisp_Object start, end;
3619 if (first)
3621 previous_description_column = 0;
3622 insert ("\n", 1);
3623 first = 0;
3626 ASET (kludge, 0, vect[i].event);
3627 start = vect[i].event;
3628 end = start;
3630 definition = vect[i].definition;
3632 /* Find consecutive chars that are identically defined. */
3633 if (INTEGERP (vect[i].event))
3635 while (i + 1 < slots_used
3636 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3637 && !NILP (Fequal (vect[i + 1].definition, definition))
3638 && vect[i].shadowed == vect[i + 1].shadowed)
3639 i++;
3640 end = vect[i].event;
3643 /* Now START .. END is the range to describe next. */
3645 /* Insert the string to describe the event START. */
3646 insert1 (Fkey_description (kludge, prefix));
3648 if (!EQ (start, end))
3650 insert (" .. ", 4);
3652 ASET (kludge, 0, end);
3653 /* Insert the string to describe the character END. */
3654 insert1 (Fkey_description (kludge, prefix));
3657 /* Print a description of the definition of this character.
3658 elt_describer will take care of spacing out far enough
3659 for alignment purposes. */
3660 (*elt_describer) (vect[i].definition, Qnil);
3662 if (vect[i].shadowed)
3664 SET_PT (PT - 1);
3665 insert_string ("\n (that binding is currently shadowed by another mode)");
3666 SET_PT (PT + 1);
3670 UNGCPRO;
3673 static void
3674 describe_vector_princ (elt, fun)
3675 Lisp_Object elt, fun;
3677 Findent_to (make_number (16), make_number (1));
3678 call1 (fun, elt);
3679 Fterpri (Qnil);
3682 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3683 doc: /* Insert a description of contents of VECTOR.
3684 This is text showing the elements of vector matched against indices.
3685 DESCRIBER is the output function used; nil means use `princ'. */)
3686 (vector, describer)
3687 Lisp_Object vector, describer;
3689 int count = SPECPDL_INDEX ();
3690 if (NILP (describer))
3691 describer = intern ("princ");
3692 specbind (Qstandard_output, Fcurrent_buffer ());
3693 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3694 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3695 Qnil, Qnil, (int *)0, 0, 0, 0);
3697 return unbind_to (count, Qnil);
3700 /* Insert in the current buffer a description of the contents of VECTOR.
3701 We call ELT_DESCRIBER to insert the description of one value found
3702 in VECTOR.
3704 ELT_PREFIX describes what "comes before" the keys or indices defined
3705 by this vector. This is a human-readable string whose size
3706 is not necessarily related to the situation.
3708 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3709 leads to this keymap.
3711 If the vector is a chartable, ELT_PREFIX is the vector
3712 of bytes that lead to the character set or portion of a character
3713 set described by this chartable.
3715 If PARTIAL is nonzero, it means do not mention suppressed commands
3716 (that assumes the vector is in a keymap).
3718 SHADOW is a list of keymaps that shadow this map.
3719 If it is non-nil, then we look up the key in those maps
3720 and we don't mention it now if it is defined by any of them.
3722 ENTIRE_MAP is the keymap in which this vector appears.
3723 If the definition in effect in the whole map does not match
3724 the one in this vector, we ignore this one.
3726 When describing a sub-char-table, INDICES is a list of
3727 indices at higher levels in this char-table,
3728 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3730 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3732 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3734 static void
3735 describe_vector (vector, prefix, args, elt_describer,
3736 partial, shadow, entire_map,
3737 indices, char_table_depth, keymap_p,
3738 mention_shadow)
3739 register Lisp_Object vector;
3740 Lisp_Object prefix, args;
3741 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3742 int partial;
3743 Lisp_Object shadow;
3744 Lisp_Object entire_map;
3745 int *indices;
3746 int char_table_depth;
3747 int keymap_p;
3748 int mention_shadow;
3750 Lisp_Object definition;
3751 Lisp_Object tem2;
3752 Lisp_Object elt_prefix = Qnil;
3753 register int i;
3754 Lisp_Object suppress;
3755 Lisp_Object kludge;
3756 int first = 1;
3757 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3758 /* Range of elements to be handled. */
3759 int from, to;
3760 /* A flag to tell if a leaf in this level of char-table is not a
3761 generic character (i.e. a complete multibyte character). */
3762 int complete_char;
3763 int character;
3764 int starting_i;
3766 suppress = Qnil;
3768 if (indices == 0)
3769 indices = (int *) alloca (3 * sizeof (int));
3771 definition = Qnil;
3773 if (!keymap_p)
3775 /* Call Fkey_description first, to avoid GC bug for the other string. */
3776 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3778 Lisp_Object tem;
3779 tem = Fkey_description (prefix, Qnil);
3780 elt_prefix = concat2 (tem, build_string (" "));
3782 prefix = Qnil;
3785 /* This vector gets used to present single keys to Flookup_key. Since
3786 that is done once per vector element, we don't want to cons up a
3787 fresh vector every time. */
3788 kludge = Fmake_vector (make_number (1), Qnil);
3789 GCPRO4 (elt_prefix, prefix, definition, kludge);
3791 if (partial)
3792 suppress = intern ("suppress-keymap");
3794 if (CHAR_TABLE_P (vector))
3796 if (char_table_depth == 0)
3798 /* VECTOR is a top level char-table. */
3799 complete_char = 1;
3800 from = 0;
3801 to = CHAR_TABLE_ORDINARY_SLOTS;
3803 else
3805 /* VECTOR is a sub char-table. */
3806 if (char_table_depth >= 3)
3807 /* A char-table is never that deep. */
3808 error ("Too deep char table");
3810 complete_char
3811 = (CHARSET_VALID_P (indices[0])
3812 && ((CHARSET_DIMENSION (indices[0]) == 1
3813 && char_table_depth == 1)
3814 || char_table_depth == 2));
3816 /* Meaningful elements are from 32th to 127th. */
3817 from = 32;
3818 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3821 else
3823 /* This does the right thing for ordinary vectors. */
3825 complete_char = 1;
3826 from = 0;
3827 to = XVECTOR (vector)->size;
3830 for (i = from; i < to; i++)
3832 int this_shadowed = 0;
3833 QUIT;
3835 if (CHAR_TABLE_P (vector))
3837 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3838 complete_char = 0;
3840 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3841 && !CHARSET_DEFINED_P (i - 128))
3842 continue;
3844 definition
3845 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3847 else
3848 definition = get_keyelt (AREF (vector, i), 0);
3850 if (NILP (definition)) continue;
3852 /* Don't mention suppressed commands. */
3853 if (SYMBOLP (definition) && partial)
3855 Lisp_Object tem;
3857 tem = Fget (definition, suppress);
3859 if (!NILP (tem)) continue;
3862 /* Set CHARACTER to the character this entry describes, if any.
3863 Also update *INDICES. */
3864 if (CHAR_TABLE_P (vector))
3866 indices[char_table_depth] = i;
3868 if (char_table_depth == 0)
3870 character = i;
3871 indices[0] = i - 128;
3873 else if (complete_char)
3875 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3877 else
3878 character = 0;
3880 else
3881 character = i;
3883 ASET (kludge, 0, make_number (character));
3885 /* If this binding is shadowed by some other map, ignore it. */
3886 if (!NILP (shadow) && complete_char)
3888 Lisp_Object tem;
3890 tem = shadow_lookup (shadow, kludge, Qt);
3892 if (!NILP (tem))
3894 if (mention_shadow)
3895 this_shadowed = 1;
3896 else
3897 continue;
3901 /* Ignore this definition if it is shadowed by an earlier
3902 one in the same keymap. */
3903 if (!NILP (entire_map) && complete_char)
3905 Lisp_Object tem;
3907 tem = Flookup_key (entire_map, kludge, Qt);
3909 if (!EQ (tem, definition))
3910 continue;
3913 if (first)
3915 if (char_table_depth == 0)
3916 insert ("\n", 1);
3917 first = 0;
3920 /* For a sub char-table, show the depth by indentation.
3921 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3922 if (char_table_depth > 0)
3923 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3925 /* Output the prefix that applies to every entry in this map. */
3926 if (!NILP (elt_prefix))
3927 insert1 (elt_prefix);
3929 /* Insert or describe the character this slot is for,
3930 or a description of what it is for. */
3931 if (SUB_CHAR_TABLE_P (vector))
3933 if (complete_char)
3934 insert_char (character);
3935 else
3937 /* We need an octal representation for this block of
3938 characters. */
3939 char work[16];
3940 sprintf (work, "(row %d)", i);
3941 insert (work, strlen (work));
3944 else if (CHAR_TABLE_P (vector))
3946 if (complete_char)
3947 insert1 (Fkey_description (kludge, prefix));
3948 else
3950 /* Print the information for this character set. */
3951 insert_string ("<");
3952 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3953 if (STRINGP (tem2))
3954 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3955 SBYTES (tem2), 0);
3956 else
3957 insert ("?", 1);
3958 insert (">", 1);
3961 else
3963 insert1 (Fkey_description (kludge, prefix));
3966 /* If we find a sub char-table within a char-table,
3967 scan it recursively; it defines the details for
3968 a character set or a portion of a character set. */
3969 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3971 insert ("\n", 1);
3972 describe_vector (definition, prefix, args, elt_describer,
3973 partial, shadow, entire_map,
3974 indices, char_table_depth + 1, keymap_p,
3975 mention_shadow);
3976 continue;
3979 starting_i = i;
3981 /* Find all consecutive characters or rows that have the same
3982 definition. But, for elements of a top level char table, if
3983 they are for charsets, we had better describe one by one even
3984 if they have the same definition. */
3985 if (CHAR_TABLE_P (vector))
3987 int limit = to;
3989 if (char_table_depth == 0)
3990 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3992 while (i + 1 < limit
3993 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3994 !NILP (tem2))
3995 && !NILP (Fequal (tem2, definition)))
3996 i++;
3998 else
3999 while (i + 1 < to
4000 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
4001 !NILP (tem2))
4002 && !NILP (Fequal (tem2, definition)))
4003 i++;
4006 /* If we have a range of more than one character,
4007 print where the range reaches to. */
4009 if (i != starting_i)
4011 insert (" .. ", 4);
4013 ASET (kludge, 0, make_number (i));
4015 if (!NILP (elt_prefix))
4016 insert1 (elt_prefix);
4018 if (CHAR_TABLE_P (vector))
4020 if (char_table_depth == 0)
4022 insert1 (Fkey_description (kludge, prefix));
4024 else if (complete_char)
4026 indices[char_table_depth] = i;
4027 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
4028 insert_char (character);
4030 else
4032 /* We need an octal representation for this block of
4033 characters. */
4034 char work[16];
4035 sprintf (work, "(row %d)", i);
4036 insert (work, strlen (work));
4039 else
4041 insert1 (Fkey_description (kludge, prefix));
4045 /* Print a description of the definition of this character.
4046 elt_describer will take care of spacing out far enough
4047 for alignment purposes. */
4048 (*elt_describer) (definition, args);
4050 if (this_shadowed)
4052 SET_PT (PT - 1);
4053 insert_string (" (binding currently shadowed)");
4054 SET_PT (PT + 1);
4058 /* For (sub) char-table, print `defalt' slot at last. */
4059 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
4061 insert (" ", char_table_depth * 2);
4062 insert_string ("<<default>>");
4063 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
4066 UNGCPRO;
4069 /* Apropos - finding all symbols whose names match a regexp. */
4070 static Lisp_Object apropos_predicate;
4071 static Lisp_Object apropos_accumulate;
4073 static void
4074 apropos_accum (symbol, string)
4075 Lisp_Object symbol, string;
4077 register Lisp_Object tem;
4079 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
4080 if (!NILP (tem) && !NILP (apropos_predicate))
4081 tem = call1 (apropos_predicate, symbol);
4082 if (!NILP (tem))
4083 apropos_accumulate = Fcons (symbol, apropos_accumulate);
4086 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
4087 doc: /* Show all symbols whose names contain match for REGEXP.
4088 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
4089 for each symbol and a symbol is mentioned only if that returns non-nil.
4090 Return list of symbols found. */)
4091 (regexp, predicate)
4092 Lisp_Object regexp, predicate;
4094 Lisp_Object tem;
4095 CHECK_STRING (regexp);
4096 apropos_predicate = predicate;
4097 apropos_accumulate = Qnil;
4098 map_obarray (Vobarray, apropos_accum, regexp);
4099 tem = Fsort (apropos_accumulate, Qstring_lessp);
4100 apropos_accumulate = Qnil;
4101 apropos_predicate = Qnil;
4102 return tem;
4105 void
4106 syms_of_keymap ()
4108 Qkeymap = intern ("keymap");
4109 staticpro (&Qkeymap);
4110 staticpro (&apropos_predicate);
4111 staticpro (&apropos_accumulate);
4112 apropos_predicate = Qnil;
4113 apropos_accumulate = Qnil;
4115 /* Now we are ready to set up this property, so we can
4116 create char tables. */
4117 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
4119 /* Initialize the keymaps standardly used.
4120 Each one is the value of a Lisp variable, and is also
4121 pointed to by a C variable */
4123 global_map = Fmake_keymap (Qnil);
4124 Fset (intern ("global-map"), global_map);
4126 current_global_map = global_map;
4127 staticpro (&global_map);
4128 staticpro (&current_global_map);
4130 meta_map = Fmake_keymap (Qnil);
4131 Fset (intern ("esc-map"), meta_map);
4132 Ffset (intern ("ESC-prefix"), meta_map);
4134 control_x_map = Fmake_keymap (Qnil);
4135 Fset (intern ("ctl-x-map"), control_x_map);
4136 Ffset (intern ("Control-X-prefix"), control_x_map);
4138 exclude_keys
4139 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4140 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4141 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4142 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4143 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4144 Qnil)))));
4145 staticpro (&exclude_keys);
4147 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4148 doc: /* List of commands given new key bindings recently.
4149 This is used for internal purposes during Emacs startup;
4150 don't alter it yourself. */);
4151 Vdefine_key_rebound_commands = Qt;
4153 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4154 doc: /* Default keymap to use when reading from the minibuffer. */);
4155 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4157 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4158 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
4159 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4160 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4162 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4163 doc: /* Local keymap for minibuffer input with completion. */);
4164 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4165 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4167 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4168 &Vminibuffer_local_filename_completion_map,
4169 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4170 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4171 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4172 Vminibuffer_local_completion_map);
4175 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4176 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4177 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4178 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4179 Vminibuffer_local_completion_map);
4181 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4182 &Vminibuffer_local_must_match_filename_map,
4183 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4184 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4185 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4186 Vminibuffer_local_must_match_map);
4188 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4189 doc: /* Alist of keymaps to use for minor modes.
4190 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4191 key sequences and look up bindings iff VARIABLE's value is non-nil.
4192 If two active keymaps bind the same key, the keymap appearing earlier
4193 in the list takes precedence. */);
4194 Vminor_mode_map_alist = Qnil;
4196 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4197 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4198 This variable is an alist just like `minor-mode-map-alist', and it is
4199 used the same way (and before `minor-mode-map-alist'); however,
4200 it is provided for major modes to bind locally. */);
4201 Vminor_mode_overriding_map_alist = Qnil;
4203 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4204 doc: /* List of keymap alists to use for emulations modes.
4205 It is intended for modes or packages using multiple minor-mode keymaps.
4206 Each element is a keymap alist just like `minor-mode-map-alist', or a
4207 symbol with a variable binding which is a keymap alist, and it is used
4208 the same way. The "active" keymaps in each alist are used before
4209 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4210 Vemulation_mode_map_alists = Qnil;
4213 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
4214 doc: /* Keymap that translates key sequences to key sequences during input.
4215 This is used mainly for mapping ASCII function key sequences into
4216 real Emacs function key events (symbols).
4218 The `read-key-sequence' function replaces any subsequence bound by
4219 `function-key-map' with its binding. More precisely, when the active
4220 keymaps have no binding for the current key sequence but
4221 `function-key-map' binds a suffix of the sequence to a vector or string,
4222 `read-key-sequence' replaces the matching suffix with its binding, and
4223 continues with the new sequence.
4225 If the binding is a function, it is called with one argument (the prompt)
4226 and its return value (a key sequence) is used.
4228 The events that come from bindings in `function-key-map' are not
4229 themselves looked up in `function-key-map'.
4231 For example, suppose `function-key-map' binds `ESC O P' to [f1].
4232 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
4233 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
4234 key, typing `ESC O P x' would return [f1 x]. */);
4235 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
4237 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
4238 doc: /* Keymap of key translations that can override keymaps.
4239 This keymap works like `function-key-map', but comes after that,
4240 and its non-prefix bindings override ordinary bindings. */);
4241 Vkey_translation_map = Qnil;
4243 staticpro (&Vmouse_events);
4244 Vmouse_events = Fcons (intern ("menu-bar"),
4245 Fcons (intern ("tool-bar"),
4246 Fcons (intern ("header-line"),
4247 Fcons (intern ("mode-line"),
4248 Fcons (intern ("mouse-1"),
4249 Fcons (intern ("mouse-2"),
4250 Fcons (intern ("mouse-3"),
4251 Fcons (intern ("mouse-4"),
4252 Fcons (intern ("mouse-5"),
4253 Qnil)))))))));
4256 Qsingle_key_description = intern ("single-key-description");
4257 staticpro (&Qsingle_key_description);
4259 Qkey_description = intern ("key-description");
4260 staticpro (&Qkey_description);
4262 Qkeymapp = intern ("keymapp");
4263 staticpro (&Qkeymapp);
4265 Qnon_ascii = intern ("non-ascii");
4266 staticpro (&Qnon_ascii);
4268 Qmenu_item = intern ("menu-item");
4269 staticpro (&Qmenu_item);
4271 Qremap = intern ("remap");
4272 staticpro (&Qremap);
4274 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4275 staticpro (&command_remapping_vector);
4277 where_is_cache_keymaps = Qt;
4278 where_is_cache = Qnil;
4279 staticpro (&where_is_cache);
4280 staticpro (&where_is_cache_keymaps);
4282 defsubr (&Skeymapp);
4283 defsubr (&Skeymap_parent);
4284 defsubr (&Skeymap_prompt);
4285 defsubr (&Sset_keymap_parent);
4286 defsubr (&Smake_keymap);
4287 defsubr (&Smake_sparse_keymap);
4288 defsubr (&Smap_keymap);
4289 defsubr (&Scopy_keymap);
4290 defsubr (&Scommand_remapping);
4291 defsubr (&Skey_binding);
4292 defsubr (&Slocal_key_binding);
4293 defsubr (&Sglobal_key_binding);
4294 defsubr (&Sminor_mode_key_binding);
4295 defsubr (&Sdefine_key);
4296 defsubr (&Slookup_key);
4297 defsubr (&Sdefine_prefix_command);
4298 defsubr (&Suse_global_map);
4299 defsubr (&Suse_local_map);
4300 defsubr (&Scurrent_local_map);
4301 defsubr (&Scurrent_global_map);
4302 defsubr (&Scurrent_minor_mode_maps);
4303 defsubr (&Scurrent_active_maps);
4304 defsubr (&Saccessible_keymaps);
4305 defsubr (&Skey_description);
4306 defsubr (&Sdescribe_vector);
4307 defsubr (&Ssingle_key_description);
4308 defsubr (&Stext_char_description);
4309 defsubr (&Swhere_is_internal);
4310 defsubr (&Sdescribe_buffer_bindings);
4311 defsubr (&Sapropos_internal);
4314 void
4315 keys_of_keymap ()
4317 initial_define_key (global_map, 033, "ESC-prefix");
4318 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4321 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4322 (do not change this comment) */