(fill-paragraph-function): Doc fix.
[emacs.git] / src / keymap.c
blob6b4b8536fe19f0532ede5e8e6ff9dab12159e0ef
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. (See info node `Extended Menu Items'.)
1130 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1131 binding is altered. If there is no binding for KEY, the new pair
1132 binding KEY to DEF is added at the front of KEYMAP. */)
1133 (keymap, key, def)
1134 Lisp_Object keymap;
1135 Lisp_Object key;
1136 Lisp_Object def;
1138 register int idx;
1139 register Lisp_Object c;
1140 register Lisp_Object cmd;
1141 int metized = 0;
1142 int meta_bit;
1143 int length;
1144 struct gcpro gcpro1, gcpro2, gcpro3;
1146 GCPRO3 (keymap, key, def);
1147 keymap = get_keymap (keymap, 1, 1);
1149 CHECK_VECTOR_OR_STRING (key);
1151 length = XFASTINT (Flength (key));
1152 if (length == 0)
1153 RETURN_UNGCPRO (Qnil);
1155 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1156 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1158 meta_bit = VECTORP (key) ? meta_modifier : 0x80;
1160 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1161 { /* DEF is apparently an XEmacs-style keyboard macro. */
1162 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1163 int i = ASIZE (def);
1164 while (--i >= 0)
1166 Lisp_Object c = AREF (def, i);
1167 if (CONSP (c) && lucid_event_type_list_p (c))
1168 c = Fevent_convert_list (c);
1169 ASET (tmp, i, c);
1171 def = tmp;
1174 idx = 0;
1175 while (1)
1177 c = Faref (key, make_number (idx));
1179 if (CONSP (c) && lucid_event_type_list_p (c))
1180 c = Fevent_convert_list (c);
1182 if (SYMBOLP (c))
1183 silly_event_symbol_error (c);
1185 if (INTEGERP (c)
1186 && (XINT (c) & meta_bit)
1187 && !metized)
1189 c = meta_prefix_char;
1190 metized = 1;
1192 else
1194 if (INTEGERP (c))
1195 XSETINT (c, XINT (c) & ~meta_bit);
1197 metized = 0;
1198 idx++;
1201 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1202 error ("Key sequence contains invalid event");
1204 if (idx == length)
1205 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1207 cmd = access_keymap (keymap, c, 0, 1, 1);
1209 /* If this key is undefined, make it a prefix. */
1210 if (NILP (cmd))
1211 cmd = define_as_prefix (keymap, c);
1213 keymap = get_keymap (cmd, 0, 1);
1214 if (!CONSP (keymap))
1215 /* We must use Fkey_description rather than just passing key to
1216 error; key might be a vector, not a string. */
1217 error ("Key sequence %s starts with non-prefix key %s",
1218 SDATA (Fkey_description (key, Qnil)),
1219 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1220 make_number (idx)),
1221 Qnil)));
1225 /* This function may GC (it calls Fkey_binding). */
1227 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 2, 0,
1228 doc: /* Return the remapping for command COMMAND in current keymaps.
1229 Returns nil if COMMAND is not remapped (or not a symbol).
1231 If the optional argument POSITION is non-nil, it specifies a mouse
1232 position as returned by `event-start' and `event-end', and the
1233 remapping occurs in the keymaps associated with it. It can also be a
1234 number or marker, in which case the keymap properties at the specified
1235 buffer position instead of point are used. */)
1236 (command, position)
1237 Lisp_Object command, position;
1239 if (!SYMBOLP (command))
1240 return Qnil;
1242 ASET (command_remapping_vector, 1, command);
1243 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1246 /* Value is number if KEY is too long; nil if valid but has no definition. */
1247 /* GC is possible in this function if it autoloads a keymap. */
1249 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1250 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1251 A value of nil means undefined. See doc of `define-key'
1252 for kinds of definitions.
1254 A number as value means KEY is "too long";
1255 that is, characters or symbols in it except for the last one
1256 fail to be a valid sequence of prefix characters in KEYMAP.
1257 The number is how many characters at the front of KEY
1258 it takes to reach a non-prefix key.
1260 Normally, `lookup-key' ignores bindings for t, which act as default
1261 bindings, used when nothing else in the keymap applies; this makes it
1262 usable as a general function for probing keymaps. However, if the
1263 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1264 recognize the default bindings, just as `read-key-sequence' does. */)
1265 (keymap, key, accept_default)
1266 Lisp_Object keymap;
1267 Lisp_Object key;
1268 Lisp_Object accept_default;
1270 register int idx;
1271 register Lisp_Object cmd;
1272 register Lisp_Object c;
1273 int length;
1274 int t_ok = !NILP (accept_default);
1275 struct gcpro gcpro1, gcpro2;
1277 GCPRO2 (keymap, key);
1278 keymap = get_keymap (keymap, 1, 1);
1280 CHECK_VECTOR_OR_STRING (key);
1282 length = XFASTINT (Flength (key));
1283 if (length == 0)
1284 RETURN_UNGCPRO (keymap);
1286 idx = 0;
1287 while (1)
1289 c = Faref (key, make_number (idx++));
1291 if (CONSP (c) && lucid_event_type_list_p (c))
1292 c = Fevent_convert_list (c);
1294 /* Turn the 8th bit of string chars into a meta modifier. */
1295 if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
1296 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1298 /* Allow string since binding for `menu-bar-select-buffer'
1299 includes the buffer name in the key sequence. */
1300 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1301 error ("Key sequence contains invalid event");
1303 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1304 if (idx == length)
1305 RETURN_UNGCPRO (cmd);
1307 keymap = get_keymap (cmd, 0, 1);
1308 if (!CONSP (keymap))
1309 RETURN_UNGCPRO (make_number (idx));
1311 QUIT;
1315 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1316 Assume that currently it does not define C at all.
1317 Return the keymap. */
1319 static Lisp_Object
1320 define_as_prefix (keymap, c)
1321 Lisp_Object keymap, c;
1323 Lisp_Object cmd;
1325 cmd = Fmake_sparse_keymap (Qnil);
1326 /* If this key is defined as a prefix in an inherited keymap,
1327 make it a prefix in this map, and make its definition
1328 inherit the other prefix definition. */
1329 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1330 store_in_keymap (keymap, c, cmd);
1332 return cmd;
1335 /* Append a key to the end of a key sequence. We always make a vector. */
1337 Lisp_Object
1338 append_key (key_sequence, key)
1339 Lisp_Object key_sequence, key;
1341 Lisp_Object args[2];
1343 args[0] = key_sequence;
1345 args[1] = Fcons (key, Qnil);
1346 return Fvconcat (2, args);
1349 /* Given a event type C which is a symbol,
1350 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1352 static void
1353 silly_event_symbol_error (c)
1354 Lisp_Object c;
1356 Lisp_Object parsed, base, name, assoc;
1357 int modifiers;
1359 parsed = parse_modifiers (c);
1360 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1361 base = XCAR (parsed);
1362 name = Fsymbol_name (base);
1363 /* This alist includes elements such as ("RET" . "\\r"). */
1364 assoc = Fassoc (name, exclude_keys);
1366 if (! NILP (assoc))
1368 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1369 char *p = new_mods;
1370 Lisp_Object keystring;
1371 if (modifiers & alt_modifier)
1372 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1373 if (modifiers & ctrl_modifier)
1374 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1375 if (modifiers & hyper_modifier)
1376 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1377 if (modifiers & meta_modifier)
1378 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1379 if (modifiers & shift_modifier)
1380 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1381 if (modifiers & super_modifier)
1382 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1383 *p = 0;
1385 c = reorder_modifiers (c);
1386 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1388 error ((modifiers & ~meta_modifier
1389 ? "To bind the key %s, use [?%s], not [%s]"
1390 : "To bind the key %s, use \"%s\", not [%s]"),
1391 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1392 SDATA (SYMBOL_NAME (c)));
1396 /* Global, local, and minor mode keymap stuff. */
1398 /* We can't put these variables inside current_minor_maps, since under
1399 some systems, static gets macro-defined to be the empty string.
1400 Ickypoo. */
1401 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1402 static int cmm_size = 0;
1404 /* Store a pointer to an array of the keymaps of the currently active
1405 minor modes in *buf, and return the number of maps it contains.
1407 This function always returns a pointer to the same buffer, and may
1408 free or reallocate it, so if you want to keep it for a long time or
1409 hand it out to lisp code, copy it. This procedure will be called
1410 for every key sequence read, so the nice lispy approach (return a
1411 new assoclist, list, what have you) for each invocation would
1412 result in a lot of consing over time.
1414 If we used xrealloc/xmalloc and ran out of memory, they would throw
1415 back to the command loop, which would try to read a key sequence,
1416 which would call this function again, resulting in an infinite
1417 loop. Instead, we'll use realloc/malloc and silently truncate the
1418 list, let the key sequence be read, and hope some other piece of
1419 code signals the error. */
1421 current_minor_maps (modeptr, mapptr)
1422 Lisp_Object **modeptr, **mapptr;
1424 int i = 0;
1425 int list_number = 0;
1426 Lisp_Object alist, assoc, var, val;
1427 Lisp_Object emulation_alists;
1428 Lisp_Object lists[2];
1430 emulation_alists = Vemulation_mode_map_alists;
1431 lists[0] = Vminor_mode_overriding_map_alist;
1432 lists[1] = Vminor_mode_map_alist;
1434 for (list_number = 0; list_number < 2; list_number++)
1436 if (CONSP (emulation_alists))
1438 alist = XCAR (emulation_alists);
1439 emulation_alists = XCDR (emulation_alists);
1440 if (SYMBOLP (alist))
1441 alist = find_symbol_value (alist);
1442 list_number = -1;
1444 else
1445 alist = lists[list_number];
1447 for ( ; CONSP (alist); alist = XCDR (alist))
1448 if ((assoc = XCAR (alist), CONSP (assoc))
1449 && (var = XCAR (assoc), SYMBOLP (var))
1450 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1451 && !NILP (val))
1453 Lisp_Object temp;
1455 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1456 and also an entry in Vminor_mode_map_alist,
1457 ignore the latter. */
1458 if (list_number == 1)
1460 val = assq_no_quit (var, lists[0]);
1461 if (!NILP (val))
1462 continue;
1465 if (i >= cmm_size)
1467 int newsize, allocsize;
1468 Lisp_Object *newmodes, *newmaps;
1470 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1471 allocsize = newsize * sizeof *newmodes;
1473 /* Use malloc here. See the comment above this function.
1474 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1475 BLOCK_INPUT;
1476 newmodes = (Lisp_Object *) malloc (allocsize);
1477 if (newmodes)
1479 if (cmm_modes)
1481 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1482 free (cmm_modes);
1484 cmm_modes = newmodes;
1487 newmaps = (Lisp_Object *) malloc (allocsize);
1488 if (newmaps)
1490 if (cmm_maps)
1492 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1493 free (cmm_maps);
1495 cmm_maps = newmaps;
1497 UNBLOCK_INPUT;
1499 if (newmodes == NULL || newmaps == NULL)
1500 break;
1501 cmm_size = newsize;
1504 /* Get the keymap definition--or nil if it is not defined. */
1505 temp = Findirect_function (XCDR (assoc), Qt);
1506 if (!NILP (temp))
1508 cmm_modes[i] = var;
1509 cmm_maps [i] = temp;
1510 i++;
1515 if (modeptr) *modeptr = cmm_modes;
1516 if (mapptr) *mapptr = cmm_maps;
1517 return i;
1520 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1521 0, 1, 0,
1522 doc: /* Return a list of the currently active keymaps.
1523 OLP if non-nil indicates that we should obey `overriding-local-map' and
1524 `overriding-terminal-local-map'. */)
1525 (olp)
1526 Lisp_Object olp;
1528 Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1530 if (!NILP (olp))
1532 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1533 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1534 /* The doc said that overriding-terminal-local-map should
1535 override overriding-local-map. The code used them both,
1536 but it seems clearer to use just one. rms, jan 2005. */
1537 else if (!NILP (Voverriding_local_map))
1538 keymaps = Fcons (Voverriding_local_map, keymaps);
1540 if (NILP (XCDR (keymaps)))
1542 Lisp_Object local;
1543 Lisp_Object *maps;
1544 int nmaps, i;
1546 /* This usually returns the buffer's local map,
1547 but that can be overridden by a `local-map' property. */
1548 local = get_local_map (PT, current_buffer, Qlocal_map);
1549 if (!NILP (local))
1550 keymaps = Fcons (local, keymaps);
1552 /* Now put all the minor mode keymaps on the list. */
1553 nmaps = current_minor_maps (0, &maps);
1555 for (i = --nmaps; i >= 0; i--)
1556 if (!NILP (maps[i]))
1557 keymaps = Fcons (maps[i], keymaps);
1559 /* This returns nil unless there is a `keymap' property. */
1560 local = get_local_map (PT, current_buffer, Qkeymap);
1561 if (!NILP (local))
1562 keymaps = Fcons (local, keymaps);
1565 return keymaps;
1568 /* GC is possible in this function if it autoloads a keymap. */
1570 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1571 doc: /* Return the binding for command KEY in current keymaps.
1572 KEY is a string or vector, a sequence of keystrokes.
1573 The binding is probably a symbol with a function definition.
1575 Normally, `key-binding' ignores bindings for t, which act as default
1576 bindings, used when nothing else in the keymap applies; this makes it
1577 usable as a general function for probing keymaps. However, if the
1578 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1579 recognize the default bindings, just as `read-key-sequence' does.
1581 Like the normal command loop, `key-binding' will remap the command
1582 resulting from looking up KEY by looking up the command in the
1583 current keymaps. However, if the optional third argument NO-REMAP
1584 is non-nil, `key-binding' returns the unmapped command.
1586 If KEY is a key sequence initiated with the mouse, the used keymaps
1587 will depend on the clicked mouse position with regard to the buffer
1588 and possible local keymaps on strings.
1590 If the optional argument POSITION is non-nil, it specifies a mouse
1591 position as returned by `event-start' and `event-end', and the lookup
1592 occurs in the keymaps associated with it instead of KEY. It can also
1593 be a number or marker, in which case the keymap properties at the
1594 specified buffer position instead of point are used.
1596 (key, accept_default, no_remap, position)
1597 Lisp_Object key, accept_default, no_remap, position;
1599 Lisp_Object *maps, value;
1600 int nmaps, i;
1601 struct gcpro gcpro1, gcpro2;
1602 int count = SPECPDL_INDEX ();
1604 GCPRO2 (key, position);
1606 if (NILP (position) && VECTORP (key))
1608 Lisp_Object event
1609 /* mouse events may have a symbolic prefix indicating the
1610 scrollbar or mode line */
1611 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1613 /* We are not interested in locations without event data */
1615 if (EVENT_HAS_PARAMETERS (event))
1617 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1618 if (CONSP (XCDR (event)) && EQ (kind, Qmouse_click))
1619 position = EVENT_START (event);
1623 /* Key sequences beginning with mouse clicks
1624 are read using the keymaps of the buffer clicked on, not
1625 the current buffer. So we may have to switch the buffer
1626 here. */
1628 if (CONSP (position))
1630 Lisp_Object window;
1632 window = POSN_WINDOW (position);
1634 if (WINDOWP (window)
1635 && BUFFERP (XWINDOW (window)->buffer)
1636 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1638 /* Arrange to go back to the original buffer once we're done
1639 processing the key sequence. We don't use
1640 save_excursion_{save,restore} here, in analogy to
1641 `read-key-sequence' to avoid saving point. Maybe this
1642 would not be a problem here, but it is easier to keep
1643 things the same.
1646 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1648 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1652 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1654 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1655 key, accept_default);
1656 if (! NILP (value) && !INTEGERP (value))
1657 goto done;
1659 else if (! NILP (Voverriding_local_map))
1661 value = Flookup_key (Voverriding_local_map, key, accept_default);
1662 if (! NILP (value) && !INTEGERP (value))
1663 goto done;
1665 else
1667 Lisp_Object keymap, local_map;
1668 EMACS_INT pt;
1670 pt = INTEGERP (position) ? XINT (position)
1671 : MARKERP (position) ? marker_position (position)
1672 : PT;
1674 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1675 keymap = get_local_map (pt, current_buffer, Qkeymap);
1677 if (CONSP (position))
1679 Lisp_Object string;
1681 /* For a mouse click, get the local text-property keymap
1682 of the place clicked on, rather than point. */
1684 if (POSN_INBUFFER_P (position))
1686 Lisp_Object pos;
1688 pos = POSN_BUFFER_POSN (position);
1689 if (INTEGERP (pos)
1690 && XINT (pos) >= BEG && XINT (pos) <= Z)
1692 local_map = get_local_map (XINT (pos),
1693 current_buffer, Qlocal_map);
1695 keymap = get_local_map (XINT (pos),
1696 current_buffer, Qkeymap);
1700 /* If on a mode line string with a local keymap,
1701 or for a click on a string, i.e. overlay string or a
1702 string displayed via the `display' property,
1703 consider `local-map' and `keymap' properties of
1704 that string. */
1706 if (string = POSN_STRING (position),
1707 (CONSP (string) && STRINGP (XCAR (string))))
1709 Lisp_Object pos, map;
1711 pos = XCDR (string);
1712 string = XCAR (string);
1713 if (INTEGERP (pos)
1714 && XINT (pos) >= 0
1715 && XINT (pos) < SCHARS (string))
1717 map = Fget_text_property (pos, Qlocal_map, string);
1718 if (!NILP (map))
1719 local_map = map;
1721 map = Fget_text_property (pos, Qkeymap, string);
1722 if (!NILP (map))
1723 keymap = map;
1729 if (! NILP (keymap))
1731 value = Flookup_key (keymap, key, accept_default);
1732 if (! NILP (value) && !INTEGERP (value))
1733 goto done;
1736 nmaps = current_minor_maps (0, &maps);
1737 /* Note that all these maps are GCPRO'd
1738 in the places where we found them. */
1740 for (i = 0; i < nmaps; i++)
1741 if (! NILP (maps[i]))
1743 value = Flookup_key (maps[i], key, accept_default);
1744 if (! NILP (value) && !INTEGERP (value))
1745 goto done;
1748 if (! NILP (local_map))
1750 value = Flookup_key (local_map, key, accept_default);
1751 if (! NILP (value) && !INTEGERP (value))
1752 goto done;
1756 value = Flookup_key (current_global_map, key, accept_default);
1758 done:
1759 unbind_to (count, Qnil);
1761 UNGCPRO;
1762 if (NILP (value) || INTEGERP (value))
1763 return Qnil;
1765 /* If the result of the ordinary keymap lookup is an interactive
1766 command, look for a key binding (ie. remapping) for that command. */
1768 if (NILP (no_remap) && SYMBOLP (value))
1770 Lisp_Object value1;
1771 if (value1 = Fcommand_remapping (value, position), !NILP (value1))
1772 value = value1;
1775 return value;
1778 /* GC is possible in this function if it autoloads a keymap. */
1780 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1781 doc: /* Return the binding for command KEYS in current local keymap only.
1782 KEYS is a string or vector, a sequence of keystrokes.
1783 The binding is probably a symbol with a function definition.
1785 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1786 bindings; see the description of `lookup-key' for more details about this. */)
1787 (keys, accept_default)
1788 Lisp_Object keys, accept_default;
1790 register Lisp_Object map;
1791 map = current_buffer->keymap;
1792 if (NILP (map))
1793 return Qnil;
1794 return Flookup_key (map, keys, accept_default);
1797 /* GC is possible in this function if it autoloads a keymap. */
1799 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1800 doc: /* Return the binding for command KEYS in current global keymap only.
1801 KEYS is a string or vector, a sequence of keystrokes.
1802 The binding is probably a symbol with a function definition.
1803 This function's return values are the same as those of `lookup-key'
1804 \(which see).
1806 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1807 bindings; see the description of `lookup-key' for more details about this. */)
1808 (keys, accept_default)
1809 Lisp_Object keys, accept_default;
1811 return Flookup_key (current_global_map, keys, accept_default);
1814 /* GC is possible in this function if it autoloads a keymap. */
1816 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1817 doc: /* Find the visible minor mode bindings of KEY.
1818 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1819 the symbol which names the minor mode binding KEY, and BINDING is
1820 KEY's definition in that mode. In particular, if KEY has no
1821 minor-mode bindings, return nil. If the first binding is a
1822 non-prefix, all subsequent bindings will be omitted, since they would
1823 be ignored. Similarly, the list doesn't include non-prefix bindings
1824 that come after prefix bindings.
1826 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1827 bindings; see the description of `lookup-key' for more details about this. */)
1828 (key, accept_default)
1829 Lisp_Object key, accept_default;
1831 Lisp_Object *modes, *maps;
1832 int nmaps;
1833 Lisp_Object binding;
1834 int i, j;
1835 struct gcpro gcpro1, gcpro2;
1837 nmaps = current_minor_maps (&modes, &maps);
1838 /* Note that all these maps are GCPRO'd
1839 in the places where we found them. */
1841 binding = Qnil;
1842 GCPRO2 (key, binding);
1844 for (i = j = 0; i < nmaps; i++)
1845 if (!NILP (maps[i])
1846 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1847 && !INTEGERP (binding))
1849 if (KEYMAPP (binding))
1850 maps[j++] = Fcons (modes[i], binding);
1851 else if (j == 0)
1852 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1855 UNGCPRO;
1856 return Flist (j, maps);
1859 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1860 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1861 A new sparse keymap is stored as COMMAND's function definition and its value.
1862 If a second optional argument MAPVAR is given, the map is stored as
1863 its value instead of as COMMAND's value; but COMMAND is still defined
1864 as a function.
1865 The third optional argument NAME, if given, supplies a menu name
1866 string for the map. This is required to use the keymap as a menu.
1867 This function returns COMMAND. */)
1868 (command, mapvar, name)
1869 Lisp_Object command, mapvar, name;
1871 Lisp_Object map;
1872 map = Fmake_sparse_keymap (name);
1873 Ffset (command, map);
1874 if (!NILP (mapvar))
1875 Fset (mapvar, map);
1876 else
1877 Fset (command, map);
1878 return command;
1881 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1882 doc: /* Select KEYMAP as the global keymap. */)
1883 (keymap)
1884 Lisp_Object keymap;
1886 keymap = get_keymap (keymap, 1, 1);
1887 current_global_map = keymap;
1889 return Qnil;
1892 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1893 doc: /* Select KEYMAP as the local keymap.
1894 If KEYMAP is nil, that means no local keymap. */)
1895 (keymap)
1896 Lisp_Object keymap;
1898 if (!NILP (keymap))
1899 keymap = get_keymap (keymap, 1, 1);
1901 current_buffer->keymap = keymap;
1903 return Qnil;
1906 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1907 doc: /* Return current buffer's local keymap, or nil if it has none. */)
1910 return current_buffer->keymap;
1913 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1914 doc: /* Return the current global keymap. */)
1917 return current_global_map;
1920 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1921 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
1924 Lisp_Object *maps;
1925 int nmaps = current_minor_maps (0, &maps);
1927 return Flist (nmaps, maps);
1930 /* Help functions for describing and documenting keymaps. */
1933 static void
1934 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
1935 Lisp_Object maps, tail, thisseq, key, cmd;
1936 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
1938 Lisp_Object tem;
1940 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1941 if (NILP (cmd))
1942 return;
1944 /* Look for and break cycles. */
1945 while (!NILP (tem = Frassq (cmd, maps)))
1947 Lisp_Object prefix = XCAR (tem);
1948 int lim = XINT (Flength (XCAR (tem)));
1949 if (lim <= XINT (Flength (thisseq)))
1950 { /* This keymap was already seen with a smaller prefix. */
1951 int i = 0;
1952 while (i < lim && EQ (Faref (prefix, make_number (i)),
1953 Faref (thisseq, make_number (i))))
1954 i++;
1955 if (i >= lim)
1956 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1957 return;
1959 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1960 but maybe `cmd' occurs again further down in `maps', so keep
1961 looking. */
1962 maps = XCDR (Fmemq (tem, maps));
1965 /* If the last key in thisseq is meta-prefix-char,
1966 turn it into a meta-ized keystroke. We know
1967 that the event we're about to append is an
1968 ascii keystroke since we're processing a
1969 keymap table. */
1970 if (is_metized)
1972 int meta_bit = meta_modifier;
1973 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1974 tem = Fcopy_sequence (thisseq);
1976 Faset (tem, last, make_number (XINT (key) | meta_bit));
1978 /* This new sequence is the same length as
1979 thisseq, so stick it in the list right
1980 after this one. */
1981 XSETCDR (tail,
1982 Fcons (Fcons (tem, cmd), XCDR (tail)));
1984 else
1986 tem = append_key (thisseq, key);
1987 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1991 static void
1992 accessible_keymaps_char_table (args, index, cmd)
1993 Lisp_Object args, index, cmd;
1995 accessible_keymaps_1 (index, cmd,
1996 XCAR (XCAR (args)),
1997 XCAR (XCDR (args)),
1998 XCDR (XCDR (args)),
1999 XINT (XCDR (XCAR (args))));
2002 /* This function cannot GC. */
2004 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2005 1, 2, 0,
2006 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2007 Returns a list of elements of the form (KEYS . MAP), where the sequence
2008 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2009 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2010 An optional argument PREFIX, if non-nil, should be a key sequence;
2011 then the value includes only maps for prefixes that start with PREFIX. */)
2012 (keymap, prefix)
2013 Lisp_Object keymap, prefix;
2015 Lisp_Object maps, tail;
2016 int prefixlen = 0;
2018 /* no need for gcpro because we don't autoload any keymaps. */
2020 if (!NILP (prefix))
2021 prefixlen = XINT (Flength (prefix));
2023 if (!NILP (prefix))
2025 /* If a prefix was specified, start with the keymap (if any) for
2026 that prefix, so we don't waste time considering other prefixes. */
2027 Lisp_Object tem;
2028 tem = Flookup_key (keymap, prefix, Qt);
2029 /* Flookup_key may give us nil, or a number,
2030 if the prefix is not defined in this particular map.
2031 It might even give us a list that isn't a keymap. */
2032 tem = get_keymap (tem, 0, 0);
2033 if (CONSP (tem))
2035 /* Convert PREFIX to a vector now, so that later on
2036 we don't have to deal with the possibility of a string. */
2037 if (STRINGP (prefix))
2039 int i, i_byte, c;
2040 Lisp_Object copy;
2042 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2043 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2045 int i_before = i;
2047 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2048 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2049 c ^= 0200 | meta_modifier;
2050 ASET (copy, i_before, make_number (c));
2052 prefix = copy;
2054 maps = Fcons (Fcons (prefix, tem), Qnil);
2056 else
2057 return Qnil;
2059 else
2060 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2061 get_keymap (keymap, 1, 0)),
2062 Qnil);
2064 /* For each map in the list maps,
2065 look at any other maps it points to,
2066 and stick them at the end if they are not already in the list.
2068 This is a breadth-first traversal, where tail is the queue of
2069 nodes, and maps accumulates a list of all nodes visited. */
2071 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2073 register Lisp_Object thisseq, thismap;
2074 Lisp_Object last;
2075 /* Does the current sequence end in the meta-prefix-char? */
2076 int is_metized;
2078 thisseq = Fcar (Fcar (tail));
2079 thismap = Fcdr (Fcar (tail));
2080 last = make_number (XINT (Flength (thisseq)) - 1);
2081 is_metized = (XINT (last) >= 0
2082 /* Don't metize the last char of PREFIX. */
2083 && XINT (last) >= prefixlen
2084 && EQ (Faref (thisseq, last), meta_prefix_char));
2086 for (; CONSP (thismap); thismap = XCDR (thismap))
2088 Lisp_Object elt;
2090 elt = XCAR (thismap);
2092 QUIT;
2094 if (CHAR_TABLE_P (elt))
2096 Lisp_Object indices[3];
2098 map_char_table (accessible_keymaps_char_table, Qnil, elt,
2099 elt, Fcons (Fcons (maps, make_number (is_metized)),
2100 Fcons (tail, thisseq)),
2101 0, indices);
2103 else if (VECTORP (elt))
2105 register int i;
2107 /* Vector keymap. Scan all the elements. */
2108 for (i = 0; i < ASIZE (elt); i++)
2109 accessible_keymaps_1 (make_number (i), AREF (elt, i),
2110 maps, tail, thisseq, is_metized);
2113 else if (CONSP (elt))
2114 accessible_keymaps_1 (XCAR (elt), XCDR (elt),
2115 maps, tail, thisseq,
2116 is_metized && INTEGERP (XCAR (elt)));
2121 return maps;
2124 Lisp_Object Qsingle_key_description, Qkey_description;
2126 /* This function cannot GC. */
2128 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2129 doc: /* Return a pretty description of key-sequence KEYS.
2130 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2131 Control characters turn into "C-foo" sequences, meta into "M-foo",
2132 spaces are put between sequence elements, etc. */)
2133 (keys, prefix)
2134 Lisp_Object keys, prefix;
2136 int len = 0;
2137 int i, i_byte;
2138 Lisp_Object *args;
2139 int size = XINT (Flength (keys));
2140 Lisp_Object list;
2141 Lisp_Object sep = build_string (" ");
2142 Lisp_Object key;
2143 int add_meta = 0;
2145 if (!NILP (prefix))
2146 size += XINT (Flength (prefix));
2148 /* This has one extra element at the end that we don't pass to Fconcat. */
2149 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2151 /* In effect, this computes
2152 (mapconcat 'single-key-description keys " ")
2153 but we shouldn't use mapconcat because it can do GC. */
2155 next_list:
2156 if (!NILP (prefix))
2157 list = prefix, prefix = Qnil;
2158 else if (!NILP (keys))
2159 list = keys, keys = Qnil;
2160 else
2162 if (add_meta)
2164 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2165 len += 2;
2167 else if (len == 0)
2168 return empty_string;
2169 return Fconcat (len - 1, args);
2172 if (STRINGP (list))
2173 size = SCHARS (list);
2174 else if (VECTORP (list))
2175 size = XVECTOR (list)->size;
2176 else if (CONSP (list))
2177 size = XINT (Flength (list));
2178 else
2179 wrong_type_argument (Qarrayp, list);
2181 i = i_byte = 0;
2183 while (i < size)
2185 if (STRINGP (list))
2187 int c;
2188 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2189 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2190 c ^= 0200 | meta_modifier;
2191 XSETFASTINT (key, c);
2193 else if (VECTORP (list))
2195 key = AREF (list, i++);
2197 else
2199 key = XCAR (list);
2200 list = XCDR (list);
2201 i++;
2204 if (add_meta)
2206 if (!INTEGERP (key)
2207 || EQ (key, meta_prefix_char)
2208 || (XINT (key) & meta_modifier))
2210 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2211 args[len++] = sep;
2212 if (EQ (key, meta_prefix_char))
2213 continue;
2215 else
2216 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2217 add_meta = 0;
2219 else if (EQ (key, meta_prefix_char))
2221 add_meta = 1;
2222 continue;
2224 args[len++] = Fsingle_key_description (key, Qnil);
2225 args[len++] = sep;
2227 goto next_list;
2231 char *
2232 push_key_description (c, p, force_multibyte)
2233 register unsigned int c;
2234 register char *p;
2235 int force_multibyte;
2237 unsigned c2;
2238 int valid_p;
2240 /* Clear all the meaningless bits above the meta bit. */
2241 c &= meta_modifier | ~ - meta_modifier;
2242 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2243 | meta_modifier | shift_modifier | super_modifier);
2245 valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2246 if (! valid_p)
2248 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2249 p += sprintf (p, "[%d]", c);
2250 return p;
2253 if (c & alt_modifier)
2255 *p++ = 'A';
2256 *p++ = '-';
2257 c -= alt_modifier;
2259 if ((c & ctrl_modifier) != 0
2260 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2262 *p++ = 'C';
2263 *p++ = '-';
2264 c &= ~ctrl_modifier;
2266 if (c & hyper_modifier)
2268 *p++ = 'H';
2269 *p++ = '-';
2270 c -= hyper_modifier;
2272 if (c & meta_modifier)
2274 *p++ = 'M';
2275 *p++ = '-';
2276 c -= meta_modifier;
2278 if (c & shift_modifier)
2280 *p++ = 'S';
2281 *p++ = '-';
2282 c -= shift_modifier;
2284 if (c & super_modifier)
2286 *p++ = 's';
2287 *p++ = '-';
2288 c -= super_modifier;
2290 if (c < 040)
2292 if (c == 033)
2294 *p++ = 'E';
2295 *p++ = 'S';
2296 *p++ = 'C';
2298 else if (c == '\t')
2300 *p++ = 'T';
2301 *p++ = 'A';
2302 *p++ = 'B';
2304 else if (c == Ctl ('M'))
2306 *p++ = 'R';
2307 *p++ = 'E';
2308 *p++ = 'T';
2310 else
2312 /* `C-' already added above. */
2313 if (c > 0 && c <= Ctl ('Z'))
2314 *p++ = c + 0140;
2315 else
2316 *p++ = c + 0100;
2319 else if (c == 0177)
2321 *p++ = 'D';
2322 *p++ = 'E';
2323 *p++ = 'L';
2325 else if (c == ' ')
2327 *p++ = 'S';
2328 *p++ = 'P';
2329 *p++ = 'C';
2331 else if (c < 128
2332 || (NILP (current_buffer->enable_multibyte_characters)
2333 && SINGLE_BYTE_CHAR_P (c)
2334 && !force_multibyte))
2336 *p++ = c;
2338 else
2340 if (force_multibyte)
2342 if (SINGLE_BYTE_CHAR_P (c))
2343 c = unibyte_char_to_multibyte (c);
2344 p += CHAR_STRING (c, p);
2346 else if (NILP (current_buffer->enable_multibyte_characters))
2348 int bit_offset;
2349 *p++ = '\\';
2350 /* The biggest character code uses 19 bits. */
2351 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2353 if (c >= (1 << bit_offset))
2354 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2357 else
2358 p += CHAR_STRING (c, p);
2361 return p;
2364 /* This function cannot GC. */
2366 DEFUN ("single-key-description", Fsingle_key_description,
2367 Ssingle_key_description, 1, 2, 0,
2368 doc: /* Return a pretty description of command character KEY.
2369 Control characters turn into C-whatever, etc.
2370 Optional argument NO-ANGLES non-nil means don't put angle brackets
2371 around function keys and event symbols. */)
2372 (key, no_angles)
2373 Lisp_Object key, no_angles;
2375 if (CONSP (key) && lucid_event_type_list_p (key))
2376 key = Fevent_convert_list (key);
2378 key = EVENT_HEAD (key);
2380 if (INTEGERP (key)) /* Normal character */
2382 unsigned int charset, c1, c2;
2383 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2385 if (SINGLE_BYTE_CHAR_P (without_bits))
2386 charset = 0;
2387 else
2388 SPLIT_CHAR (without_bits, charset, c1, c2);
2390 if (! CHAR_VALID_P (without_bits, 1))
2392 char buf[256];
2394 sprintf (buf, "Invalid char code %d", XINT (key));
2395 return build_string (buf);
2397 else if (charset
2398 && ((c1 == 0 && c2 == -1) || c2 == 0))
2400 /* Handle a generic character. */
2401 Lisp_Object name;
2402 char buf[256];
2404 name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2405 CHECK_STRING (name);
2406 if (c1 == 0)
2407 /* Only a charset is specified. */
2408 sprintf (buf, "Generic char %d: all of ", without_bits);
2409 else
2410 /* 1st code-point of 2-dimensional charset is specified. */
2411 sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2412 return concat2 (build_string (buf), name);
2414 else
2416 char tem[KEY_DESCRIPTION_SIZE], *end;
2417 int nbytes, nchars;
2418 Lisp_Object string;
2420 end = push_key_description (XUINT (key), tem, 1);
2421 nbytes = end - tem;
2422 nchars = multibyte_chars_in_text (tem, nbytes);
2423 if (nchars == nbytes)
2425 *end = '\0';
2426 string = build_string (tem);
2428 else
2429 string = make_multibyte_string (tem, nchars, nbytes);
2430 return string;
2433 else if (SYMBOLP (key)) /* Function key or event-symbol */
2435 if (NILP (no_angles))
2437 char *buffer
2438 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2439 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2440 return build_string (buffer);
2442 else
2443 return Fsymbol_name (key);
2445 else if (STRINGP (key)) /* Buffer names in the menubar. */
2446 return Fcopy_sequence (key);
2447 else
2448 error ("KEY must be an integer, cons, symbol, or string");
2449 return Qnil;
2452 char *
2453 push_text_char_description (c, p)
2454 register unsigned int c;
2455 register char *p;
2457 if (c >= 0200)
2459 *p++ = 'M';
2460 *p++ = '-';
2461 c -= 0200;
2463 if (c < 040)
2465 *p++ = '^';
2466 *p++ = c + 64; /* 'A' - 1 */
2468 else if (c == 0177)
2470 *p++ = '^';
2471 *p++ = '?';
2473 else
2474 *p++ = c;
2475 return p;
2478 /* This function cannot GC. */
2480 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2481 doc: /* Return a pretty description of file-character CHARACTER.
2482 Control characters turn into "^char", etc. This differs from
2483 `single-key-description' which turns them into "C-char".
2484 Also, this function recognizes the 2**7 bit as the Meta character,
2485 whereas `single-key-description' uses the 2**27 bit for Meta.
2486 See Info node `(elisp)Describing Characters' for examples. */)
2487 (character)
2488 Lisp_Object character;
2490 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2491 unsigned char str[6];
2492 int c;
2494 CHECK_NUMBER (character);
2496 c = XINT (character);
2497 if (!SINGLE_BYTE_CHAR_P (c))
2499 int len = CHAR_STRING (c, str);
2501 return make_multibyte_string (str, 1, len);
2504 *push_text_char_description (c & 0377, str) = 0;
2506 return build_string (str);
2509 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2510 a meta bit. */
2511 static int
2512 ascii_sequence_p (seq)
2513 Lisp_Object seq;
2515 int i;
2516 int len = XINT (Flength (seq));
2518 for (i = 0; i < len; i++)
2520 Lisp_Object ii, elt;
2522 XSETFASTINT (ii, i);
2523 elt = Faref (seq, ii);
2525 if (!INTEGERP (elt)
2526 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2527 return 0;
2530 return 1;
2534 /* where-is - finding a command in a set of keymaps. */
2536 static Lisp_Object where_is_internal ();
2537 static Lisp_Object where_is_internal_1 ();
2538 static void where_is_internal_2 ();
2540 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2541 Returns the first non-nil binding found in any of those maps. */
2543 static Lisp_Object
2544 shadow_lookup (shadow, key, flag)
2545 Lisp_Object shadow, key, flag;
2547 Lisp_Object tail, value;
2549 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2551 value = Flookup_key (XCAR (tail), key, flag);
2552 if (NATNUMP (value))
2554 value = Flookup_key (XCAR (tail),
2555 Fsubstring (key, make_number (0), value), flag);
2556 if (!NILP (value))
2557 return Qnil;
2559 else if (!NILP (value))
2560 return value;
2562 return Qnil;
2565 static Lisp_Object Vmouse_events;
2567 /* This function can GC if Flookup_key autoloads any keymaps. */
2569 static Lisp_Object
2570 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2571 Lisp_Object definition, keymaps;
2572 Lisp_Object firstonly, noindirect, no_remap;
2574 Lisp_Object maps = Qnil;
2575 Lisp_Object found, sequences;
2576 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2577 /* 1 means ignore all menu bindings entirely. */
2578 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2580 /* If this command is remapped, then it has no key bindings
2581 of its own. */
2582 if (NILP (no_remap) && SYMBOLP (definition))
2584 Lisp_Object tem;
2585 if (tem = Fcommand_remapping (definition, Qnil), !NILP (tem))
2586 return Qnil;
2589 found = keymaps;
2590 while (CONSP (found))
2592 maps =
2593 nconc2 (maps,
2594 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2595 found = XCDR (found);
2598 GCPRO5 (definition, keymaps, maps, found, sequences);
2599 found = Qnil;
2600 sequences = Qnil;
2602 for (; !NILP (maps); maps = Fcdr (maps))
2604 /* Key sequence to reach map, and the map that it reaches */
2605 register Lisp_Object this, map, tem;
2607 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2608 [M-CHAR] sequences, check if last character of the sequence
2609 is the meta-prefix char. */
2610 Lisp_Object last;
2611 int last_is_meta;
2613 this = Fcar (Fcar (maps));
2614 map = Fcdr (Fcar (maps));
2615 last = make_number (XINT (Flength (this)) - 1);
2616 last_is_meta = (XINT (last) >= 0
2617 && EQ (Faref (this, last), meta_prefix_char));
2619 /* if (nomenus && !ascii_sequence_p (this)) */
2620 if (nomenus && XINT (last) >= 0
2621 && SYMBOLP (tem = Faref (this, make_number (0)))
2622 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2623 /* If no menu entries should be returned, skip over the
2624 keymaps bound to `menu-bar' and `tool-bar' and other
2625 non-ascii prefixes like `C-down-mouse-2'. */
2626 continue;
2628 QUIT;
2630 while (CONSP (map))
2632 /* Because the code we want to run on each binding is rather
2633 large, we don't want to have two separate loop bodies for
2634 sparse keymap bindings and tables; we want to iterate one
2635 loop body over both keymap and vector bindings.
2637 For this reason, if Fcar (map) is a vector, we don't
2638 advance map to the next element until i indicates that we
2639 have finished off the vector. */
2640 Lisp_Object elt, key, binding;
2641 elt = XCAR (map);
2642 map = XCDR (map);
2644 sequences = Qnil;
2646 QUIT;
2648 /* Set key and binding to the current key and binding, and
2649 advance map and i to the next binding. */
2650 if (VECTORP (elt))
2652 Lisp_Object sequence;
2653 int i;
2654 /* In a vector, look at each element. */
2655 for (i = 0; i < XVECTOR (elt)->size; i++)
2657 binding = AREF (elt, i);
2658 XSETFASTINT (key, i);
2659 sequence = where_is_internal_1 (binding, key, definition,
2660 noindirect, this,
2661 last, nomenus, last_is_meta);
2662 if (!NILP (sequence))
2663 sequences = Fcons (sequence, sequences);
2666 else if (CHAR_TABLE_P (elt))
2668 Lisp_Object indices[3];
2669 Lisp_Object args;
2671 args = Fcons (Fcons (Fcons (definition, noindirect),
2672 Qnil), /* Result accumulator. */
2673 Fcons (Fcons (this, last),
2674 Fcons (make_number (nomenus),
2675 make_number (last_is_meta))));
2676 map_char_table (where_is_internal_2, Qnil, elt, elt, args,
2677 0, indices);
2678 sequences = XCDR (XCAR (args));
2680 else if (CONSP (elt))
2682 Lisp_Object sequence;
2684 key = XCAR (elt);
2685 binding = XCDR (elt);
2687 sequence = where_is_internal_1 (binding, key, definition,
2688 noindirect, this,
2689 last, nomenus, last_is_meta);
2690 if (!NILP (sequence))
2691 sequences = Fcons (sequence, sequences);
2695 while (!NILP (sequences))
2697 Lisp_Object sequence, remapped, function;
2699 sequence = XCAR (sequences);
2700 sequences = XCDR (sequences);
2702 /* If the current sequence is a command remapping with
2703 format [remap COMMAND], find the key sequences
2704 which run COMMAND, and use those sequences instead. */
2705 remapped = Qnil;
2706 if (NILP (no_remap)
2707 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2708 && EQ (AREF (sequence, 0), Qremap)
2709 && (function = AREF (sequence, 1), SYMBOLP (function)))
2711 Lisp_Object remapped1;
2713 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2714 if (CONSP (remapped1))
2716 /* Verify that this key binding actually maps to the
2717 remapped command (see below). */
2718 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2719 continue;
2720 sequence = XCAR (remapped1);
2721 remapped = XCDR (remapped1);
2722 goto record_sequence;
2726 /* Verify that this key binding is not shadowed by another
2727 binding for the same key, before we say it exists.
2729 Mechanism: look for local definition of this key and if
2730 it is defined and does not match what we found then
2731 ignore this key.
2733 Either nil or number as value from Flookup_key
2734 means undefined. */
2735 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2736 continue;
2738 record_sequence:
2739 /* Don't annoy user with strings from a menu such as
2740 Select Paste. Change them all to "(any string)",
2741 so that there seems to be only one menu item
2742 to report. */
2743 if (! NILP (sequence))
2745 Lisp_Object tem;
2746 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2747 if (STRINGP (tem))
2748 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2749 build_string ("(any string)"));
2752 /* It is a true unshadowed match. Record it, unless it's already
2753 been seen (as could happen when inheriting keymaps). */
2754 if (NILP (Fmember (sequence, found)))
2755 found = Fcons (sequence, found);
2757 /* If firstonly is Qnon_ascii, then we can return the first
2758 binding we find. If firstonly is not Qnon_ascii but not
2759 nil, then we should return the first ascii-only binding
2760 we find. */
2761 if (EQ (firstonly, Qnon_ascii))
2762 RETURN_UNGCPRO (sequence);
2763 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2764 RETURN_UNGCPRO (sequence);
2766 if (CONSP (remapped))
2768 sequence = XCAR (remapped);
2769 remapped = XCDR (remapped);
2770 goto record_sequence;
2776 UNGCPRO;
2778 found = Fnreverse (found);
2780 /* firstonly may have been t, but we may have gone all the way through
2781 the keymaps without finding an all-ASCII key sequence. So just
2782 return the best we could find. */
2783 if (!NILP (firstonly))
2784 return Fcar (found);
2786 return found;
2789 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2790 doc: /* Return list of keys that invoke DEFINITION.
2791 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2792 If KEYMAP is nil, search all the currently active keymaps.
2793 If KEYMAP is a list of keymaps, search only those keymaps.
2795 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2796 rather than a list of all possible key sequences.
2797 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2798 no matter what it is.
2799 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2800 \(or their meta variants) and entirely reject menu bindings.
2802 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2803 to other keymaps or slots. This makes it possible to search for an
2804 indirect definition itself.
2806 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2807 that invoke a command which is remapped to DEFINITION, but include the
2808 remapped command in the returned list. */)
2809 (definition, keymap, firstonly, noindirect, no_remap)
2810 Lisp_Object definition, keymap;
2811 Lisp_Object firstonly, noindirect, no_remap;
2813 Lisp_Object sequences, keymaps;
2814 /* 1 means ignore all menu bindings entirely. */
2815 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2816 Lisp_Object result;
2818 /* Find the relevant keymaps. */
2819 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2820 keymaps = keymap;
2821 else if (!NILP (keymap))
2822 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2823 else
2824 keymaps = Fcurrent_active_maps (Qnil);
2826 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2827 We don't really need to check `keymap'. */
2828 if (nomenus && NILP (noindirect) && NILP (keymap))
2830 Lisp_Object *defns;
2831 int i, j, n;
2832 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2834 /* Check heuristic-consistency of the cache. */
2835 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2836 where_is_cache = Qnil;
2838 if (NILP (where_is_cache))
2840 /* We need to create the cache. */
2841 Lisp_Object args[2];
2842 where_is_cache = Fmake_hash_table (0, args);
2843 where_is_cache_keymaps = Qt;
2845 /* Fill in the cache. */
2846 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2847 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2848 UNGCPRO;
2850 where_is_cache_keymaps = keymaps;
2853 /* We want to process definitions from the last to the first.
2854 Instead of consing, copy definitions to a vector and step
2855 over that vector. */
2856 sequences = Fgethash (definition, where_is_cache, Qnil);
2857 n = XINT (Flength (sequences));
2858 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2859 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2860 defns[i++] = XCAR (sequences);
2862 /* Verify that the key bindings are not shadowed. Note that
2863 the following can GC. */
2864 GCPRO2 (definition, keymaps);
2865 result = Qnil;
2866 j = -1;
2867 for (i = n - 1; i >= 0; --i)
2868 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2870 if (ascii_sequence_p (defns[i]))
2871 break;
2872 else if (j < 0)
2873 j = i;
2876 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2877 UNGCPRO;
2879 else
2881 /* Kill the cache so that where_is_internal_1 doesn't think
2882 we're filling it up. */
2883 where_is_cache = Qnil;
2884 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2887 return result;
2890 /* This is the function that Fwhere_is_internal calls using map_char_table.
2891 ARGS has the form
2892 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2894 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2895 Since map_char_table doesn't really use the return value from this function,
2896 we the result append to RESULT, the slot in ARGS.
2898 This function can GC because it calls where_is_internal_1 which can
2899 GC. */
2901 static void
2902 where_is_internal_2 (args, key, binding)
2903 Lisp_Object args, key, binding;
2905 Lisp_Object definition, noindirect, this, last;
2906 Lisp_Object result, sequence;
2907 int nomenus, last_is_meta;
2908 struct gcpro gcpro1, gcpro2, gcpro3;
2910 GCPRO3 (args, key, binding);
2911 result = XCDR (XCAR (args));
2912 definition = XCAR (XCAR (XCAR (args)));
2913 noindirect = XCDR (XCAR (XCAR (args)));
2914 this = XCAR (XCAR (XCDR (args)));
2915 last = XCDR (XCAR (XCDR (args)));
2916 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2917 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2919 sequence = where_is_internal_1 (binding, key, definition, noindirect,
2920 this, last, nomenus, last_is_meta);
2922 if (!NILP (sequence))
2923 XSETCDR (XCAR (args), Fcons (sequence, result));
2925 UNGCPRO;
2929 /* This function can GC because get_keyelt can. */
2931 static Lisp_Object
2932 where_is_internal_1 (binding, key, definition, noindirect, this, last,
2933 nomenus, last_is_meta)
2934 Lisp_Object binding, key, definition, noindirect, this, last;
2935 int nomenus, last_is_meta;
2937 Lisp_Object sequence;
2939 /* Search through indirections unless that's not wanted. */
2940 if (NILP (noindirect))
2941 binding = get_keyelt (binding, 0);
2943 /* End this iteration if this element does not match
2944 the target. */
2946 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2947 || EQ (binding, definition)
2948 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2949 /* Doesn't match. */
2950 return Qnil;
2952 /* We have found a match. Construct the key sequence where we found it. */
2953 if (INTEGERP (key) && last_is_meta)
2955 sequence = Fcopy_sequence (this);
2956 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2958 else
2959 sequence = append_key (this, key);
2961 if (!NILP (where_is_cache))
2963 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2964 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2965 return Qnil;
2967 else
2968 return sequence;
2971 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2973 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2974 doc: /* Insert the list of all defined keys and their definitions.
2975 The list is inserted in the current buffer, while the bindings are
2976 looked up in BUFFER.
2977 The optional argument PREFIX, if non-nil, should be a key sequence;
2978 then we display only bindings that start with that prefix.
2979 The optional argument MENUS, if non-nil, says to mention menu bindings.
2980 \(Ordinarily these are omitted from the output.) */)
2981 (buffer, prefix, menus)
2982 Lisp_Object buffer, prefix, menus;
2984 Lisp_Object outbuf, shadow;
2985 int nomenu = NILP (menus);
2986 register Lisp_Object start1;
2987 struct gcpro gcpro1;
2989 char *alternate_heading
2990 = "\
2991 Keyboard translations:\n\n\
2992 You type Translation\n\
2993 -------- -----------\n";
2995 shadow = Qnil;
2996 GCPRO1 (shadow);
2998 outbuf = Fcurrent_buffer ();
3000 /* Report on alternates for keys. */
3001 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
3003 int c;
3004 const unsigned char *translate = SDATA (Vkeyboard_translate_table);
3005 int translate_len = SCHARS (Vkeyboard_translate_table);
3007 for (c = 0; c < translate_len; c++)
3008 if (translate[c] != c)
3010 char buf[KEY_DESCRIPTION_SIZE];
3011 char *bufend;
3013 if (alternate_heading)
3015 insert_string (alternate_heading);
3016 alternate_heading = 0;
3019 bufend = push_key_description (translate[c], buf, 1);
3020 insert (buf, bufend - buf);
3021 Findent_to (make_number (16), make_number (1));
3022 bufend = push_key_description (c, buf, 1);
3023 insert (buf, bufend - buf);
3025 insert ("\n", 1);
3027 /* Insert calls signal_after_change which may GC. */
3028 translate = SDATA (Vkeyboard_translate_table);
3031 insert ("\n", 1);
3034 if (!NILP (Vkey_translation_map))
3035 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3036 "Key translations", nomenu, 1, 0, 0);
3039 /* Print the (major mode) local map. */
3040 start1 = Qnil;
3041 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3042 start1 = current_kboard->Voverriding_terminal_local_map;
3043 else if (!NILP (Voverriding_local_map))
3044 start1 = Voverriding_local_map;
3046 if (!NILP (start1))
3048 describe_map_tree (start1, 1, shadow, prefix,
3049 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3050 shadow = Fcons (start1, shadow);
3052 else
3054 /* Print the minor mode and major mode keymaps. */
3055 int i, nmaps;
3056 Lisp_Object *modes, *maps;
3058 /* Temporarily switch to `buffer', so that we can get that buffer's
3059 minor modes correctly. */
3060 Fset_buffer (buffer);
3062 nmaps = current_minor_maps (&modes, &maps);
3063 Fset_buffer (outbuf);
3065 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3066 XBUFFER (buffer), Qkeymap);
3067 if (!NILP (start1))
3069 describe_map_tree (start1, 1, shadow, prefix,
3070 "\f\n`keymap' Property Bindings", nomenu,
3071 0, 0, 0);
3072 shadow = Fcons (start1, shadow);
3075 /* Print the minor mode maps. */
3076 for (i = 0; i < nmaps; i++)
3078 /* The title for a minor mode keymap
3079 is constructed at run time.
3080 We let describe_map_tree do the actual insertion
3081 because it takes care of other features when doing so. */
3082 char *title, *p;
3084 if (!SYMBOLP (modes[i]))
3085 abort();
3087 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3088 *p++ = '\f';
3089 *p++ = '\n';
3090 *p++ = '`';
3091 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3092 SCHARS (SYMBOL_NAME (modes[i])));
3093 p += SCHARS (SYMBOL_NAME (modes[i]));
3094 *p++ = '\'';
3095 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3096 p += sizeof (" Minor Mode Bindings") - 1;
3097 *p = 0;
3099 describe_map_tree (maps[i], 1, shadow, prefix,
3100 title, nomenu, 0, 0, 0);
3101 shadow = Fcons (maps[i], shadow);
3104 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3105 XBUFFER (buffer), Qlocal_map);
3106 if (!NILP (start1))
3108 if (EQ (start1, XBUFFER (buffer)->keymap))
3109 describe_map_tree (start1, 1, shadow, prefix,
3110 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3111 else
3112 describe_map_tree (start1, 1, shadow, prefix,
3113 "\f\n`local-map' Property Bindings",
3114 nomenu, 0, 0, 0);
3116 shadow = Fcons (start1, shadow);
3120 describe_map_tree (current_global_map, 1, shadow, prefix,
3121 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3123 /* Print the function-key-map translations under this prefix. */
3124 if (!NILP (Vfunction_key_map))
3125 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
3126 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3128 UNGCPRO;
3129 return Qnil;
3132 /* Insert a description of the key bindings in STARTMAP,
3133 followed by those of all maps reachable through STARTMAP.
3134 If PARTIAL is nonzero, omit certain "uninteresting" commands
3135 (such as `undefined').
3136 If SHADOW is non-nil, it is a list of maps;
3137 don't mention keys which would be shadowed by any of them.
3138 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3139 TITLE, if not 0, is a string to insert at the beginning.
3140 TITLE should not end with a colon or a newline; we supply that.
3141 If NOMENU is not 0, then omit menu-bar commands.
3143 If TRANSL is nonzero, the definitions are actually key translations
3144 so print strings and vectors differently.
3146 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3147 to look through.
3149 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3150 don't omit it; instead, mention it but say it is shadowed. */
3152 void
3153 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3154 always_title, mention_shadow)
3155 Lisp_Object startmap, shadow, prefix;
3156 int partial;
3157 char *title;
3158 int nomenu;
3159 int transl;
3160 int always_title;
3161 int mention_shadow;
3163 Lisp_Object maps, orig_maps, seen, sub_shadows;
3164 struct gcpro gcpro1, gcpro2, gcpro3;
3165 int something = 0;
3166 char *key_heading
3167 = "\
3168 key binding\n\
3169 --- -------\n";
3171 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3172 seen = Qnil;
3173 sub_shadows = Qnil;
3174 GCPRO3 (maps, seen, sub_shadows);
3176 if (nomenu)
3178 Lisp_Object list;
3180 /* Delete from MAPS each element that is for the menu bar. */
3181 for (list = maps; !NILP (list); list = XCDR (list))
3183 Lisp_Object elt, prefix, tem;
3185 elt = Fcar (list);
3186 prefix = Fcar (elt);
3187 if (XVECTOR (prefix)->size >= 1)
3189 tem = Faref (prefix, make_number (0));
3190 if (EQ (tem, Qmenu_bar))
3191 maps = Fdelq (elt, maps);
3196 if (!NILP (maps) || always_title)
3198 if (title)
3200 insert_string (title);
3201 if (!NILP (prefix))
3203 insert_string (" Starting With ");
3204 insert1 (Fkey_description (prefix, Qnil));
3206 insert_string (":\n");
3208 insert_string (key_heading);
3209 something = 1;
3212 for (; !NILP (maps); maps = Fcdr (maps))
3214 register Lisp_Object elt, prefix, tail;
3216 elt = Fcar (maps);
3217 prefix = Fcar (elt);
3219 sub_shadows = Qnil;
3221 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3223 Lisp_Object shmap;
3225 shmap = XCAR (tail);
3227 /* If the sequence by which we reach this keymap is zero-length,
3228 then the shadow map for this keymap is just SHADOW. */
3229 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3230 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3232 /* If the sequence by which we reach this keymap actually has
3233 some elements, then the sequence's definition in SHADOW is
3234 what we should use. */
3235 else
3237 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3238 if (INTEGERP (shmap))
3239 shmap = Qnil;
3242 /* If shmap is not nil and not a keymap,
3243 it completely shadows this map, so don't
3244 describe this map at all. */
3245 if (!NILP (shmap) && !KEYMAPP (shmap))
3246 goto skip;
3248 if (!NILP (shmap))
3249 sub_shadows = Fcons (shmap, sub_shadows);
3252 /* Maps we have already listed in this loop shadow this map. */
3253 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3255 Lisp_Object tem;
3256 tem = Fequal (Fcar (XCAR (tail)), prefix);
3257 if (!NILP (tem))
3258 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3261 describe_map (Fcdr (elt), prefix,
3262 transl ? describe_translation : describe_command,
3263 partial, sub_shadows, &seen, nomenu, mention_shadow);
3265 skip: ;
3268 if (something)
3269 insert_string ("\n");
3271 UNGCPRO;
3274 static int previous_description_column;
3276 static void
3277 describe_command (definition, args)
3278 Lisp_Object definition, args;
3280 register Lisp_Object tem1;
3281 int column = (int) current_column (); /* iftc */
3282 int description_column;
3284 /* If column 16 is no good, go to col 32;
3285 but don't push beyond that--go to next line instead. */
3286 if (column > 30)
3288 insert_char ('\n');
3289 description_column = 32;
3291 else if (column > 14 || (column > 10 && previous_description_column == 32))
3292 description_column = 32;
3293 else
3294 description_column = 16;
3296 Findent_to (make_number (description_column), make_number (1));
3297 previous_description_column = description_column;
3299 if (SYMBOLP (definition))
3301 tem1 = SYMBOL_NAME (definition);
3302 insert1 (tem1);
3303 insert_string ("\n");
3305 else if (STRINGP (definition) || VECTORP (definition))
3306 insert_string ("Keyboard Macro\n");
3307 else if (KEYMAPP (definition))
3308 insert_string ("Prefix Command\n");
3309 else
3310 insert_string ("??\n");
3313 static void
3314 describe_translation (definition, args)
3315 Lisp_Object definition, args;
3317 register Lisp_Object tem1;
3319 Findent_to (make_number (16), make_number (1));
3321 if (SYMBOLP (definition))
3323 tem1 = SYMBOL_NAME (definition);
3324 insert1 (tem1);
3325 insert_string ("\n");
3327 else if (STRINGP (definition) || VECTORP (definition))
3329 insert1 (Fkey_description (definition, Qnil));
3330 insert_string ("\n");
3332 else if (KEYMAPP (definition))
3333 insert_string ("Prefix Command\n");
3334 else
3335 insert_string ("??\n");
3338 /* describe_map puts all the usable elements of a sparse keymap
3339 into an array of `struct describe_map_elt',
3340 then sorts them by the events. */
3342 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3344 /* qsort comparison function for sorting `struct describe_map_elt' by
3345 the event field. */
3347 static int
3348 describe_map_compare (aa, bb)
3349 const void *aa, *bb;
3351 const struct describe_map_elt *a = aa, *b = bb;
3352 if (INTEGERP (a->event) && INTEGERP (b->event))
3353 return ((XINT (a->event) > XINT (b->event))
3354 - (XINT (a->event) < XINT (b->event)));
3355 if (!INTEGERP (a->event) && INTEGERP (b->event))
3356 return 1;
3357 if (INTEGERP (a->event) && !INTEGERP (b->event))
3358 return -1;
3359 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3360 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3361 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3362 : 0);
3363 return 0;
3366 /* Describe the contents of map MAP, assuming that this map itself is
3367 reached by the sequence of prefix keys PREFIX (a string or vector).
3368 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3370 static void
3371 describe_map (map, prefix, elt_describer, partial, shadow,
3372 seen, nomenu, mention_shadow)
3373 register Lisp_Object map;
3374 Lisp_Object prefix;
3375 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3376 int partial;
3377 Lisp_Object shadow;
3378 Lisp_Object *seen;
3379 int nomenu;
3380 int mention_shadow;
3382 Lisp_Object tail, definition, event;
3383 Lisp_Object tem;
3384 Lisp_Object suppress;
3385 Lisp_Object kludge;
3386 int first = 1;
3387 struct gcpro gcpro1, gcpro2, gcpro3;
3389 /* These accumulate the values from sparse keymap bindings,
3390 so we can sort them and handle them in order. */
3391 int length_needed = 0;
3392 struct describe_map_elt *vect;
3393 int slots_used = 0;
3394 int i;
3396 suppress = Qnil;
3398 if (partial)
3399 suppress = intern ("suppress-keymap");
3401 /* This vector gets used to present single keys to Flookup_key. Since
3402 that is done once per keymap element, we don't want to cons up a
3403 fresh vector every time. */
3404 kludge = Fmake_vector (make_number (1), Qnil);
3405 definition = Qnil;
3407 for (tail = map; CONSP (tail); tail = XCDR (tail))
3408 length_needed++;
3410 vect = ((struct describe_map_elt *)
3411 alloca (sizeof (struct describe_map_elt) * length_needed));
3413 GCPRO3 (prefix, definition, kludge);
3415 for (tail = map; CONSP (tail); tail = XCDR (tail))
3417 QUIT;
3419 if (VECTORP (XCAR (tail))
3420 || CHAR_TABLE_P (XCAR (tail)))
3421 describe_vector (XCAR (tail),
3422 prefix, Qnil, elt_describer, partial, shadow, map,
3423 (int *)0, 0, 1, mention_shadow);
3424 else if (CONSP (XCAR (tail)))
3426 int this_shadowed = 0;
3428 event = XCAR (XCAR (tail));
3430 /* Ignore bindings whose "prefix" are not really valid events.
3431 (We get these in the frames and buffers menu.) */
3432 if (!(SYMBOLP (event) || INTEGERP (event)))
3433 continue;
3435 if (nomenu && EQ (event, Qmenu_bar))
3436 continue;
3438 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3440 /* Don't show undefined commands or suppressed commands. */
3441 if (NILP (definition)) continue;
3442 if (SYMBOLP (definition) && partial)
3444 tem = Fget (definition, suppress);
3445 if (!NILP (tem))
3446 continue;
3449 /* Don't show a command that isn't really visible
3450 because a local definition of the same key shadows it. */
3452 ASET (kludge, 0, event);
3453 if (!NILP (shadow))
3455 tem = shadow_lookup (shadow, kludge, Qt);
3456 if (!NILP (tem))
3458 /* If both bindings are keymaps, this key is a prefix key,
3459 so don't say it is shadowed. */
3460 if (KEYMAPP (definition) && KEYMAPP (tem))
3462 /* Avoid generating duplicate entries if the
3463 shadowed binding has the same definition. */
3464 else if (mention_shadow && !EQ (tem, definition))
3465 this_shadowed = 1;
3466 else
3467 continue;
3471 tem = Flookup_key (map, kludge, Qt);
3472 if (!EQ (tem, definition)) continue;
3474 vect[slots_used].event = event;
3475 vect[slots_used].definition = definition;
3476 vect[slots_used].shadowed = this_shadowed;
3477 slots_used++;
3479 else if (EQ (XCAR (tail), Qkeymap))
3481 /* The same keymap might be in the structure twice, if we're
3482 using an inherited keymap. So skip anything we've already
3483 encountered. */
3484 tem = Fassq (tail, *seen);
3485 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3486 break;
3487 *seen = Fcons (Fcons (tail, prefix), *seen);
3491 /* If we found some sparse map events, sort them. */
3493 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3494 describe_map_compare);
3496 /* Now output them in sorted order. */
3498 for (i = 0; i < slots_used; i++)
3500 Lisp_Object start, end;
3502 if (first)
3504 previous_description_column = 0;
3505 insert ("\n", 1);
3506 first = 0;
3509 ASET (kludge, 0, vect[i].event);
3510 start = vect[i].event;
3511 end = start;
3513 definition = vect[i].definition;
3515 /* Find consecutive chars that are identically defined. */
3516 if (INTEGERP (vect[i].event))
3518 while (i + 1 < slots_used
3519 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3520 && !NILP (Fequal (vect[i + 1].definition, definition))
3521 && vect[i].shadowed == vect[i + 1].shadowed)
3522 i++;
3523 end = vect[i].event;
3526 /* Now START .. END is the range to describe next. */
3528 /* Insert the string to describe the event START. */
3529 insert1 (Fkey_description (kludge, prefix));
3531 if (!EQ (start, end))
3533 insert (" .. ", 4);
3535 ASET (kludge, 0, end);
3536 /* Insert the string to describe the character END. */
3537 insert1 (Fkey_description (kludge, prefix));
3540 /* Print a description of the definition of this character.
3541 elt_describer will take care of spacing out far enough
3542 for alignment purposes. */
3543 (*elt_describer) (vect[i].definition, Qnil);
3545 if (vect[i].shadowed)
3547 SET_PT (PT - 1);
3548 insert_string ("\n (that binding is currently shadowed by another mode)");
3549 SET_PT (PT + 1);
3553 UNGCPRO;
3556 static void
3557 describe_vector_princ (elt, fun)
3558 Lisp_Object elt, fun;
3560 Findent_to (make_number (16), make_number (1));
3561 call1 (fun, elt);
3562 Fterpri (Qnil);
3565 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3566 doc: /* Insert a description of contents of VECTOR.
3567 This is text showing the elements of vector matched against indices.
3568 DESCRIBER is the output function used; nil means use `princ'. */)
3569 (vector, describer)
3570 Lisp_Object vector, describer;
3572 int count = SPECPDL_INDEX ();
3573 if (NILP (describer))
3574 describer = intern ("princ");
3575 specbind (Qstandard_output, Fcurrent_buffer ());
3576 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3577 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3578 Qnil, Qnil, (int *)0, 0, 0, 0);
3580 return unbind_to (count, Qnil);
3583 /* Insert in the current buffer a description of the contents of VECTOR.
3584 We call ELT_DESCRIBER to insert the description of one value found
3585 in VECTOR.
3587 ELT_PREFIX describes what "comes before" the keys or indices defined
3588 by this vector. This is a human-readable string whose size
3589 is not necessarily related to the situation.
3591 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3592 leads to this keymap.
3594 If the vector is a chartable, ELT_PREFIX is the vector
3595 of bytes that lead to the character set or portion of a character
3596 set described by this chartable.
3598 If PARTIAL is nonzero, it means do not mention suppressed commands
3599 (that assumes the vector is in a keymap).
3601 SHADOW is a list of keymaps that shadow this map.
3602 If it is non-nil, then we look up the key in those maps
3603 and we don't mention it now if it is defined by any of them.
3605 ENTIRE_MAP is the keymap in which this vector appears.
3606 If the definition in effect in the whole map does not match
3607 the one in this vector, we ignore this one.
3609 When describing a sub-char-table, INDICES is a list of
3610 indices at higher levels in this char-table,
3611 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3613 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3615 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3617 static void
3618 describe_vector (vector, prefix, args, elt_describer,
3619 partial, shadow, entire_map,
3620 indices, char_table_depth, keymap_p,
3621 mention_shadow)
3622 register Lisp_Object vector;
3623 Lisp_Object prefix, args;
3624 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3625 int partial;
3626 Lisp_Object shadow;
3627 Lisp_Object entire_map;
3628 int *indices;
3629 int char_table_depth;
3630 int keymap_p;
3631 int mention_shadow;
3633 Lisp_Object definition;
3634 Lisp_Object tem2;
3635 Lisp_Object elt_prefix = Qnil;
3636 register int i;
3637 Lisp_Object suppress;
3638 Lisp_Object kludge;
3639 int first = 1;
3640 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3641 /* Range of elements to be handled. */
3642 int from, to;
3643 /* A flag to tell if a leaf in this level of char-table is not a
3644 generic character (i.e. a complete multibyte character). */
3645 int complete_char;
3646 int character;
3647 int starting_i;
3649 suppress = Qnil;
3651 if (indices == 0)
3652 indices = (int *) alloca (3 * sizeof (int));
3654 definition = Qnil;
3656 if (!keymap_p)
3658 /* Call Fkey_description first, to avoid GC bug for the other string. */
3659 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3661 Lisp_Object tem;
3662 tem = Fkey_description (prefix, Qnil);
3663 elt_prefix = concat2 (tem, build_string (" "));
3665 prefix = Qnil;
3668 /* This vector gets used to present single keys to Flookup_key. Since
3669 that is done once per vector element, we don't want to cons up a
3670 fresh vector every time. */
3671 kludge = Fmake_vector (make_number (1), Qnil);
3672 GCPRO4 (elt_prefix, prefix, definition, kludge);
3674 if (partial)
3675 suppress = intern ("suppress-keymap");
3677 if (CHAR_TABLE_P (vector))
3679 if (char_table_depth == 0)
3681 /* VECTOR is a top level char-table. */
3682 complete_char = 1;
3683 from = 0;
3684 to = CHAR_TABLE_ORDINARY_SLOTS;
3686 else
3688 /* VECTOR is a sub char-table. */
3689 if (char_table_depth >= 3)
3690 /* A char-table is never that deep. */
3691 error ("Too deep char table");
3693 complete_char
3694 = (CHARSET_VALID_P (indices[0])
3695 && ((CHARSET_DIMENSION (indices[0]) == 1
3696 && char_table_depth == 1)
3697 || char_table_depth == 2));
3699 /* Meaningful elements are from 32th to 127th. */
3700 from = 32;
3701 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3704 else
3706 /* This does the right thing for ordinary vectors. */
3708 complete_char = 1;
3709 from = 0;
3710 to = XVECTOR (vector)->size;
3713 for (i = from; i < to; i++)
3715 int this_shadowed = 0;
3716 QUIT;
3718 if (CHAR_TABLE_P (vector))
3720 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3721 complete_char = 0;
3723 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3724 && !CHARSET_DEFINED_P (i - 128))
3725 continue;
3727 definition
3728 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3730 else
3731 definition = get_keyelt (AREF (vector, i), 0);
3733 if (NILP (definition)) continue;
3735 /* Don't mention suppressed commands. */
3736 if (SYMBOLP (definition) && partial)
3738 Lisp_Object tem;
3740 tem = Fget (definition, suppress);
3742 if (!NILP (tem)) continue;
3745 /* Set CHARACTER to the character this entry describes, if any.
3746 Also update *INDICES. */
3747 if (CHAR_TABLE_P (vector))
3749 indices[char_table_depth] = i;
3751 if (char_table_depth == 0)
3753 character = i;
3754 indices[0] = i - 128;
3756 else if (complete_char)
3758 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3760 else
3761 character = 0;
3763 else
3764 character = i;
3766 ASET (kludge, 0, make_number (character));
3768 /* If this binding is shadowed by some other map, ignore it. */
3769 if (!NILP (shadow) && complete_char)
3771 Lisp_Object tem;
3773 tem = shadow_lookup (shadow, kludge, Qt);
3775 if (!NILP (tem))
3777 if (mention_shadow)
3778 this_shadowed = 1;
3779 else
3780 continue;
3784 /* Ignore this definition if it is shadowed by an earlier
3785 one in the same keymap. */
3786 if (!NILP (entire_map) && complete_char)
3788 Lisp_Object tem;
3790 tem = Flookup_key (entire_map, kludge, Qt);
3792 if (!EQ (tem, definition))
3793 continue;
3796 if (first)
3798 if (char_table_depth == 0)
3799 insert ("\n", 1);
3800 first = 0;
3803 /* For a sub char-table, show the depth by indentation.
3804 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3805 if (char_table_depth > 0)
3806 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3808 /* Output the prefix that applies to every entry in this map. */
3809 if (!NILP (elt_prefix))
3810 insert1 (elt_prefix);
3812 /* Insert or describe the character this slot is for,
3813 or a description of what it is for. */
3814 if (SUB_CHAR_TABLE_P (vector))
3816 if (complete_char)
3817 insert_char (character);
3818 else
3820 /* We need an octal representation for this block of
3821 characters. */
3822 char work[16];
3823 sprintf (work, "(row %d)", i);
3824 insert (work, strlen (work));
3827 else if (CHAR_TABLE_P (vector))
3829 if (complete_char)
3830 insert1 (Fkey_description (kludge, prefix));
3831 else
3833 /* Print the information for this character set. */
3834 insert_string ("<");
3835 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3836 if (STRINGP (tem2))
3837 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3838 SBYTES (tem2), 0);
3839 else
3840 insert ("?", 1);
3841 insert (">", 1);
3844 else
3846 insert1 (Fkey_description (kludge, prefix));
3849 /* If we find a sub char-table within a char-table,
3850 scan it recursively; it defines the details for
3851 a character set or a portion of a character set. */
3852 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3854 insert ("\n", 1);
3855 describe_vector (definition, prefix, args, elt_describer,
3856 partial, shadow, entire_map,
3857 indices, char_table_depth + 1, keymap_p,
3858 mention_shadow);
3859 continue;
3862 starting_i = i;
3864 /* Find all consecutive characters or rows that have the same
3865 definition. But, for elements of a top level char table, if
3866 they are for charsets, we had better describe one by one even
3867 if they have the same definition. */
3868 if (CHAR_TABLE_P (vector))
3870 int limit = to;
3872 if (char_table_depth == 0)
3873 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3875 while (i + 1 < limit
3876 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3877 !NILP (tem2))
3878 && !NILP (Fequal (tem2, definition)))
3879 i++;
3881 else
3882 while (i + 1 < to
3883 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3884 !NILP (tem2))
3885 && !NILP (Fequal (tem2, definition)))
3886 i++;
3889 /* If we have a range of more than one character,
3890 print where the range reaches to. */
3892 if (i != starting_i)
3894 insert (" .. ", 4);
3896 ASET (kludge, 0, make_number (i));
3898 if (!NILP (elt_prefix))
3899 insert1 (elt_prefix);
3901 if (CHAR_TABLE_P (vector))
3903 if (char_table_depth == 0)
3905 insert1 (Fkey_description (kludge, prefix));
3907 else if (complete_char)
3909 indices[char_table_depth] = i;
3910 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3911 insert_char (character);
3913 else
3915 /* We need an octal representation for this block of
3916 characters. */
3917 char work[16];
3918 sprintf (work, "(row %d)", i);
3919 insert (work, strlen (work));
3922 else
3924 insert1 (Fkey_description (kludge, prefix));
3928 /* Print a description of the definition of this character.
3929 elt_describer will take care of spacing out far enough
3930 for alignment purposes. */
3931 (*elt_describer) (definition, args);
3933 if (this_shadowed)
3935 SET_PT (PT - 1);
3936 insert_string (" (binding currently shadowed)");
3937 SET_PT (PT + 1);
3941 /* For (sub) char-table, print `defalt' slot at last. */
3942 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3944 insert (" ", char_table_depth * 2);
3945 insert_string ("<<default>>");
3946 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3949 UNGCPRO;
3952 /* Apropos - finding all symbols whose names match a regexp. */
3953 static Lisp_Object apropos_predicate;
3954 static Lisp_Object apropos_accumulate;
3956 static void
3957 apropos_accum (symbol, string)
3958 Lisp_Object symbol, string;
3960 register Lisp_Object tem;
3962 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3963 if (!NILP (tem) && !NILP (apropos_predicate))
3964 tem = call1 (apropos_predicate, symbol);
3965 if (!NILP (tem))
3966 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3969 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3970 doc: /* Show all symbols whose names contain match for REGEXP.
3971 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3972 for each symbol and a symbol is mentioned only if that returns non-nil.
3973 Return list of symbols found. */)
3974 (regexp, predicate)
3975 Lisp_Object regexp, predicate;
3977 Lisp_Object tem;
3978 CHECK_STRING (regexp);
3979 apropos_predicate = predicate;
3980 apropos_accumulate = Qnil;
3981 map_obarray (Vobarray, apropos_accum, regexp);
3982 tem = Fsort (apropos_accumulate, Qstring_lessp);
3983 apropos_accumulate = Qnil;
3984 apropos_predicate = Qnil;
3985 return tem;
3988 void
3989 syms_of_keymap ()
3991 Qkeymap = intern ("keymap");
3992 staticpro (&Qkeymap);
3993 staticpro (&apropos_predicate);
3994 staticpro (&apropos_accumulate);
3995 apropos_predicate = Qnil;
3996 apropos_accumulate = Qnil;
3998 /* Now we are ready to set up this property, so we can
3999 create char tables. */
4000 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
4002 /* Initialize the keymaps standardly used.
4003 Each one is the value of a Lisp variable, and is also
4004 pointed to by a C variable */
4006 global_map = Fmake_keymap (Qnil);
4007 Fset (intern ("global-map"), global_map);
4009 current_global_map = global_map;
4010 staticpro (&global_map);
4011 staticpro (&current_global_map);
4013 meta_map = Fmake_keymap (Qnil);
4014 Fset (intern ("esc-map"), meta_map);
4015 Ffset (intern ("ESC-prefix"), meta_map);
4017 control_x_map = Fmake_keymap (Qnil);
4018 Fset (intern ("ctl-x-map"), control_x_map);
4019 Ffset (intern ("Control-X-prefix"), control_x_map);
4021 exclude_keys
4022 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4023 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4024 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4025 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4026 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4027 Qnil)))));
4028 staticpro (&exclude_keys);
4030 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4031 doc: /* List of commands given new key bindings recently.
4032 This is used for internal purposes during Emacs startup;
4033 don't alter it yourself. */);
4034 Vdefine_key_rebound_commands = Qt;
4036 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4037 doc: /* Default keymap to use when reading from the minibuffer. */);
4038 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4040 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4041 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
4042 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4043 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4045 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4046 doc: /* Local keymap for minibuffer input with completion. */);
4047 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4048 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4050 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4051 &Vminibuffer_local_filename_completion_map,
4052 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4053 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4054 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4055 Vminibuffer_local_completion_map);
4058 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4059 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4060 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4061 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4062 Vminibuffer_local_completion_map);
4064 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4065 &Vminibuffer_local_must_match_filename_map,
4066 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4067 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4068 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4069 Vminibuffer_local_must_match_map);
4071 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4072 doc: /* Alist of keymaps to use for minor modes.
4073 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4074 key sequences and look up bindings iff VARIABLE's value is non-nil.
4075 If two active keymaps bind the same key, the keymap appearing earlier
4076 in the list takes precedence. */);
4077 Vminor_mode_map_alist = Qnil;
4079 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4080 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4081 This variable is an alist just like `minor-mode-map-alist', and it is
4082 used the same way (and before `minor-mode-map-alist'); however,
4083 it is provided for major modes to bind locally. */);
4084 Vminor_mode_overriding_map_alist = Qnil;
4086 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4087 doc: /* List of keymap alists to use for emulations modes.
4088 It is intended for modes or packages using multiple minor-mode keymaps.
4089 Each element is a keymap alist just like `minor-mode-map-alist', or a
4090 symbol with a variable binding which is a keymap alist, and it is used
4091 the same way. The "active" keymaps in each alist are used before
4092 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4093 Vemulation_mode_map_alists = Qnil;
4096 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
4097 doc: /* Keymap that translates key sequences to key sequences during input.
4098 This is used mainly for mapping ASCII function key sequences into
4099 real Emacs function key events (symbols).
4101 The `read-key-sequence' function replaces any subsequence bound by
4102 `function-key-map' with its binding. More precisely, when the active
4103 keymaps have no binding for the current key sequence but
4104 `function-key-map' binds a suffix of the sequence to a vector or string,
4105 `read-key-sequence' replaces the matching suffix with its binding, and
4106 continues with the new sequence.
4108 If the binding is a function, it is called with one argument (the prompt)
4109 and its return value (a key sequence) is used.
4111 The events that come from bindings in `function-key-map' are not
4112 themselves looked up in `function-key-map'.
4114 For example, suppose `function-key-map' binds `ESC O P' to [f1].
4115 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
4116 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
4117 key, typing `ESC O P x' would return [f1 x]. */);
4118 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
4120 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
4121 doc: /* Keymap of key translations that can override keymaps.
4122 This keymap works like `function-key-map', but comes after that,
4123 and its non-prefix bindings override ordinary bindings. */);
4124 Vkey_translation_map = Qnil;
4126 staticpro (&Vmouse_events);
4127 Vmouse_events = Fcons (intern ("menu-bar"),
4128 Fcons (intern ("tool-bar"),
4129 Fcons (intern ("header-line"),
4130 Fcons (intern ("mode-line"),
4131 Fcons (intern ("mouse-1"),
4132 Fcons (intern ("mouse-2"),
4133 Fcons (intern ("mouse-3"),
4134 Fcons (intern ("mouse-4"),
4135 Fcons (intern ("mouse-5"),
4136 Qnil)))))))));
4139 Qsingle_key_description = intern ("single-key-description");
4140 staticpro (&Qsingle_key_description);
4142 Qkey_description = intern ("key-description");
4143 staticpro (&Qkey_description);
4145 Qkeymapp = intern ("keymapp");
4146 staticpro (&Qkeymapp);
4148 Qnon_ascii = intern ("non-ascii");
4149 staticpro (&Qnon_ascii);
4151 Qmenu_item = intern ("menu-item");
4152 staticpro (&Qmenu_item);
4154 Qremap = intern ("remap");
4155 staticpro (&Qremap);
4157 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4158 staticpro (&command_remapping_vector);
4160 where_is_cache_keymaps = Qt;
4161 where_is_cache = Qnil;
4162 staticpro (&where_is_cache);
4163 staticpro (&where_is_cache_keymaps);
4165 defsubr (&Skeymapp);
4166 defsubr (&Skeymap_parent);
4167 defsubr (&Skeymap_prompt);
4168 defsubr (&Sset_keymap_parent);
4169 defsubr (&Smake_keymap);
4170 defsubr (&Smake_sparse_keymap);
4171 defsubr (&Smap_keymap);
4172 defsubr (&Scopy_keymap);
4173 defsubr (&Scommand_remapping);
4174 defsubr (&Skey_binding);
4175 defsubr (&Slocal_key_binding);
4176 defsubr (&Sglobal_key_binding);
4177 defsubr (&Sminor_mode_key_binding);
4178 defsubr (&Sdefine_key);
4179 defsubr (&Slookup_key);
4180 defsubr (&Sdefine_prefix_command);
4181 defsubr (&Suse_global_map);
4182 defsubr (&Suse_local_map);
4183 defsubr (&Scurrent_local_map);
4184 defsubr (&Scurrent_global_map);
4185 defsubr (&Scurrent_minor_mode_maps);
4186 defsubr (&Scurrent_active_maps);
4187 defsubr (&Saccessible_keymaps);
4188 defsubr (&Skey_description);
4189 defsubr (&Sdescribe_vector);
4190 defsubr (&Ssingle_key_description);
4191 defsubr (&Stext_char_description);
4192 defsubr (&Swhere_is_internal);
4193 defsubr (&Sdescribe_buffer_bindings);
4194 defsubr (&Sapropos_internal);
4197 void
4198 keys_of_keymap ()
4200 initial_define_key (global_map, 033, "ESC-prefix");
4201 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4204 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4205 (do not change this comment) */