Merge from emacs--rel--22
[bpt/emacs.git] / src / keymap.c
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.
5
6 This file is part of GNU Emacs.
7
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.
12
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.
17
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. */
22
23
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"
40
41 /* The number of elements in keymap vectors. */
42 #define DENSE_TABLE_SIZE (0200)
43
44 /* Actually allocate storage for these variables */
45
46 Lisp_Object current_global_map; /* Current global keymap */
47
48 Lisp_Object global_map; /* default global key bindings */
49
50 Lisp_Object meta_map; /* The keymap used for globally bound
51 ESC-prefixed default commands */
52
53 Lisp_Object control_x_map; /* The keymap used for globally bound
54 C-x-prefixed default commands */
55
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 */
61
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 */
67
68 /* keymap used for minibuffers when doing completion */
69 /* was MinibufLocalCompletionMap */
70 Lisp_Object Vminibuffer_local_completion_map;
71
72 /* keymap used for minibuffers when doing completion in filenames */
73 Lisp_Object Vminibuffer_local_filename_completion_map;
74
75 /* keymap used for minibuffers when doing completion in filenames
76 with require-match*/
77 Lisp_Object Vminibuffer_local_must_match_filename_map;
78
79 /* keymap used for minibuffers when doing completion and require a match */
80 /* was MinibufLocalMustMatchMap */
81 Lisp_Object Vminibuffer_local_must_match_map;
82
83 /* Alist of minor mode variables and keymaps. */
84 Lisp_Object Vminor_mode_map_alist;
85
86 /* Alist of major-mode-specific overrides for
87 minor mode variables and keymaps. */
88 Lisp_Object Vminor_mode_overriding_map_alist;
89
90 /* List of emulation mode keymap alists. */
91 Lisp_Object Vemulation_mode_map_alists;
92
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;
97
98 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
99 Lisp_Object Vkey_translation_map;
100
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;
106
107 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
108
109 /* Alist of elements like (DEL . "\d"). */
110 static Lisp_Object exclude_keys;
111
112 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
113 static Lisp_Object command_remapping_vector;
114
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;
119
120 extern Lisp_Object Voverriding_local_map;
121
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;
126
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));
129
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));
141 \f
142 /* Keymap object support - constructors and predicates. */
143
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.
151
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;
156 {
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));
164 }
165
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.
172
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;
177 {
178 if (!NILP (string))
179 return Fcons (Qkeymap, Fcons (string, Qnil));
180 return Fcons (Qkeymap, Qnil);
181 }
182
183 /* This function is used for installing the standard key bindings
184 at initialization time.
185
186 For example:
187
188 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
189
190 void
191 initial_define_key (keymap, key, defname)
192 Lisp_Object keymap;
193 int key;
194 char *defname;
195 {
196 store_in_keymap (keymap, make_number (key), intern (defname));
197 }
198
199 void
200 initial_define_lispy_key (keymap, keyname, defname)
201 Lisp_Object keymap;
202 char *keyname;
203 char *defname;
204 {
205 store_in_keymap (keymap, intern (keyname), intern (defname));
206 }
207
208 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
209 doc: /* Return t if OBJECT is a keymap.
210
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;
218 {
219 return (KEYMAPP (object) ? Qt : Qnil);
220 }
221
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;
228 {
229 map = get_keymap (map, 0, 0);
230 while (CONSP (map))
231 {
232 Lisp_Object tem = XCAR (map);
233 if (STRINGP (tem))
234 return tem;
235 map = XCDR (map);
236 }
237 return Qnil;
238 }
239
240 /* Check that OBJECT is a keymap (after dereferencing through any
241 symbols). If it is, return it.
242
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.
246
247 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
248 is zero as well), return Qt.
249
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.
252
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.
258
259 This function can GC when AUTOLOAD is non-zero, because it calls
260 do_autoload which can GC. */
261
262 Lisp_Object
263 get_keymap (object, error, autoload)
264 Lisp_Object object;
265 int error, autoload;
266 {
267 Lisp_Object tem;
268
269 autoload_retry:
270 if (NILP (object))
271 goto end;
272 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
273 return object;
274
275 tem = indirect_function (object);
276 if (CONSP (tem))
277 {
278 if (EQ (XCAR (tem), Qkeymap))
279 return tem;
280
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))
285 {
286 Lisp_Object tail;
287
288 tail = Fnth (make_number (4), tem);
289 if (EQ (tail, Qkeymap))
290 {
291 if (autoload)
292 {
293 struct gcpro gcpro1, gcpro2;
294
295 GCPRO2 (tem, object);
296 do_autoload (tem, object);
297 UNGCPRO;
298
299 goto autoload_retry;
300 }
301 else
302 return Qt;
303 }
304 }
305 }
306
307 end:
308 if (error)
309 wrong_type_argument (Qkeymapp, object);
310 return Qnil;
311 }
312 \f
313 /* Return the parent map of KEYMAP, or nil if it has none.
314 We assume that KEYMAP is a valid keymap. */
315
316 Lisp_Object
317 keymap_parent (keymap, autoload)
318 Lisp_Object keymap;
319 int autoload;
320 {
321 Lisp_Object list;
322
323 keymap = get_keymap (keymap, 1, autoload);
324
325 /* Skip past the initial element `keymap'. */
326 list = XCDR (keymap);
327 for (; CONSP (list); list = XCDR (list))
328 {
329 /* See if there is another `keymap'. */
330 if (KEYMAPP (list))
331 return list;
332 }
333
334 return get_keymap (list, 0, autoload);
335 }
336
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;
341 {
342 return keymap_parent (keymap, 1);
343 }
344
345 /* Check whether MAP is one of MAPS parents. */
346 int
347 keymap_memberp (map, maps)
348 Lisp_Object map, maps;
349 {
350 if (NILP (map)) return 0;
351 while (KEYMAPP (maps) && !EQ (map, maps))
352 maps = keymap_parent (maps, 0);
353 return (EQ (map, maps));
354 }
355
356 /* Set the parent keymap of MAP to PARENT. */
357
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;
363 {
364 Lisp_Object list, prev;
365 struct gcpro gcpro1, gcpro2;
366 int i;
367
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;
376
377 GCPRO2 (keymap, parent);
378 keymap = get_keymap (keymap, 1, 1);
379
380 if (!NILP (parent))
381 {
382 parent = get_keymap (parent, 1, 1);
383
384 /* Check for cycles. */
385 if (keymap_memberp (keymap, parent))
386 error ("Cyclic keymap inheritance");
387 }
388
389 /* Skip past the initial element `keymap'. */
390 prev = keymap;
391 while (1)
392 {
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))
397 {
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);
402
403 CHECK_IMPURE (prev);
404 XSETCDR (prev, parent);
405 break;
406 }
407 prev = list;
408 }
409
410 /* Scan through for submaps, and set their parents too. */
411
412 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
413 {
414 /* Stop the scan when we come to the parent. */
415 if (EQ (XCAR (list), Qkeymap))
416 break;
417
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)));
423
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]);
429
430 if (CHAR_TABLE_P (XCAR (list)))
431 {
432 int indices[3];
433
434 map_char_table (fix_submap_inheritance, Qnil,
435 XCAR (list), XCAR (list),
436 keymap, 0, indices);
437 }
438 }
439
440 RETURN_UNGCPRO (parent);
441 }
442
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. */
446
447 static void
448 fix_submap_inheritance (map, event, submap)
449 Lisp_Object map, event, submap;
450 {
451 Lisp_Object map_parent, parent_entry;
452
453 /* SUBMAP is a cons that we found as a key binding.
454 Discard the other things found in a menu key binding. */
455
456 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
457
458 /* If it isn't a keymap now, there's no work to do. */
459 if (!CONSP (submap))
460 return;
461
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;
468
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;
473
474 if (! EQ (parent_entry, submap))
475 {
476 Lisp_Object submap_parent;
477 submap_parent = submap;
478 while (1)
479 {
480 Lisp_Object tem;
481
482 tem = keymap_parent (submap_parent, 0);
483
484 if (KEYMAPP (tem))
485 {
486 if (keymap_memberp (tem, parent_entry))
487 /* Fset_keymap_parent could create a cycle. */
488 return;
489 submap_parent = tem;
490 }
491 else
492 break;
493 }
494 Fset_keymap_parent (submap_parent, parent_entry);
495 }
496 }
497 \f
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.
501
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.
505
506 If T_OK is zero, bindings for Qt are not treated specially.
507
508 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
509
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;
517 {
518 Lisp_Object val;
519
520 /* Qunbound in VAL means we have found no binding yet. */
521 val = Qunbound;
522
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);
527
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)));
536
537 /* Handle the special meta -> esc mapping. */
538 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
539 {
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))
554 {
555 map = meta_map;
556 idx = make_number (XUINT (idx) & ~meta_modifier);
557 }
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;
564 }
565
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. */
569 {
570 Lisp_Object tail;
571 Lisp_Object t_binding = Qnil;
572 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
573
574 GCPRO4 (map, tail, idx, t_binding);
575
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;
580
581 for (tail = XCDR (map);
582 (CONSP (tail)
583 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
584 tail = XCDR (tail))
585 {
586 Lisp_Object binding;
587
588 binding = XCAR (tail);
589 if (SYMBOLP (binding))
590 {
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);
595 }
596 else if (CONSP (binding))
597 {
598 Lisp_Object key = XCAR (binding);
599
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))))
613 {
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;
619 }
620 else if (t_ok > 1 && EQ (key, Qt))
621 {
622 t_binding = XCDR (binding);
623 t_ok = 1;
624 }
625 }
626 else if (VECTORP (binding))
627 {
628 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
629 val = AREF (binding, XFASTINT (idx));
630 }
631 else if (CHAR_TABLE_P (binding))
632 {
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)
637 {
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;
644 }
645 }
646
647 /* If we found a binding, clean it up and return it. */
648 if (!EQ (val, Qunbound))
649 {
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);
659 }
660 QUIT;
661 }
662 UNGCPRO;
663 return get_keyelt (t_binding, autoload);
664 }
665 }
666
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;
672 {
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);
678 }
679
680 static void
681 map_keymap_char_table_item (args, key, val)
682 Lisp_Object args, key, val;
683 {
684 if (!NILP (val))
685 {
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);
690 }
691 }
692
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;
702 {
703 struct gcpro gcpro1, gcpro2, gcpro3;
704 Lisp_Object tail;
705
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))
712 {
713 Lisp_Object binding = XCAR (tail);
714
715 if (CONSP (binding))
716 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
717 else if (VECTORP (binding))
718 {
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++)
723 {
724 Lisp_Object character;
725 XSETFASTINT (character, c);
726 map_keymap_item (fun, args, character, AREF (binding, c), data);
727 }
728 }
729 else if (CHAR_TABLE_P (binding))
730 {
731 int 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);
737 }
738 }
739 UNGCPRO;
740 }
741
742 static void
743 map_keymap_call (key, val, fun, dummy)
744 Lisp_Object key, val, fun;
745 void *dummy;
746 {
747 call2 (fun, key, val);
748 }
749
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.
757
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;
764 {
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);
771
772 map_keymap (keymap, map_keymap_call, function, NULL, 1);
773 return Qnil;
774 }
775
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.
781
782 Also if OBJECT has a menu string as the first element,
783 remove that. Also remove a menu help string as second element.
784
785 If AUTOLOAD is nonzero, load autoloadable keymaps
786 that are referred to with indirection.
787
788 This can GC because menu_item_eval_property calls Feval. */
789
790 Lisp_Object
791 get_keyelt (object, autoload)
792 Lisp_Object object;
793 int autoload;
794 {
795 while (1)
796 {
797 if (!(CONSP (object)))
798 /* This is really the value. */
799 return object;
800
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;
805
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))
810 {
811 if (CONSP (XCDR (object)))
812 {
813 Lisp_Object tem;
814
815 object = XCDR (XCDR (object));
816 tem = object;
817 if (CONSP (object))
818 object = XCAR (object);
819
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)
825 {
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;
831 }
832 }
833 else
834 /* Invalid keymap. */
835 return object;
836 }
837
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)))
842 {
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)))
850 {
851 Lisp_Object carcar;
852 carcar = XCAR (XCAR (object));
853 if (NILP (carcar) || VECTORP (carcar))
854 object = XCDR (object);
855 }
856 }
857
858 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
859 else
860 {
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));
868 }
869 }
870 }
871
872 static Lisp_Object
873 store_in_keymap (keymap, idx, def)
874 Lisp_Object keymap;
875 register Lisp_Object idx;
876 Lisp_Object def;
877 {
878 /* Flush any reverse-map cache. */
879 where_is_cache = Qnil;
880 where_is_cache_keymaps = Qt;
881
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));
887
888 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
889 error ("attempt to define a key in a non-keymap");
890
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);
895
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)));
904
905 /* Scan the keymap for a binding of idx. */
906 {
907 Lisp_Object tail;
908
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;
916
917 insertion_point = keymap;
918 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
919 {
920 Lisp_Object elt;
921
922 elt = XCAR (tail);
923 if (VECTORP (elt))
924 {
925 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
926 {
927 CHECK_IMPURE (elt);
928 ASET (elt, XFASTINT (idx), def);
929 return def;
930 }
931 insertion_point = tail;
932 }
933 else if (CHAR_TABLE_P (elt))
934 {
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))
939 {
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;
946 }
947 insertion_point = tail;
948 }
949 else if (CONSP (elt))
950 {
951 if (EQ (idx, XCAR (elt)))
952 {
953 CHECK_IMPURE (elt);
954 XSETCDR (elt, def);
955 return def;
956 }
957 }
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;
964
965 QUIT;
966 }
967
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)));
974 }
975
976 return def;
977 }
978
979 EXFUN (Fcopy_keymap, 1);
980
981 Lisp_Object
982 copy_keymap_item (elt)
983 Lisp_Object elt;
984 {
985 Lisp_Object res, tem;
986
987 if (!CONSP (elt))
988 return elt;
989
990 res = tem = elt;
991
992 /* Is this a new format menu item. */
993 if (EQ (XCAR (tem), Qmenu_item))
994 {
995 /* Copy cell with menu-item marker. */
996 res = elt = Fcons (XCAR (tem), XCDR (tem));
997 tem = XCDR (elt);
998 if (CONSP (tem))
999 {
1000 /* Copy cell with menu-item name. */
1001 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1002 elt = XCDR (elt);
1003 tem = XCDR (elt);
1004 }
1005 if (CONSP (tem))
1006 {
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));
1018 }
1019 }
1020 else
1021 {
1022 /* It may be an old fomat menu item.
1023 Skip the optional menu string. */
1024 if (STRINGP (XCAR (tem)))
1025 {
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)))
1031 {
1032 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1033 elt = XCDR (elt);
1034 tem = XCDR (elt);
1035 }
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)))))
1042 {
1043 XSETCDR (elt, XCDR (tem));
1044 tem = XCDR (tem);
1045 }
1046 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1047 XSETCDR (elt, Fcopy_keymap (tem));
1048 }
1049 else if (EQ (XCAR (tem), Qkeymap))
1050 res = Fcopy_keymap (elt);
1051 }
1052 return res;
1053 }
1054
1055 static void
1056 copy_keymap_1 (chartable, idx, elt)
1057 Lisp_Object chartable, idx, elt;
1058 {
1059 Faset (chartable, idx, copy_keymap_item (elt));
1060 }
1061
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;
1071 {
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. */
1076
1077 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1078 {
1079 Lisp_Object elt = XCAR (keymap);
1080 if (CHAR_TABLE_P (elt))
1081 {
1082 int indices[3];
1083 elt = Fcopy_sequence (elt);
1084 map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
1085 }
1086 else if (VECTORP (elt))
1087 {
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)));
1092 }
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);
1098 }
1099 XSETCDR (tail, keymap);
1100 return copy;
1101 }
1102 \f
1103 /* Simple Keymap mutators and accessors. */
1104
1105 /* GC is possible in this function if it autoloads a keymap. */
1106
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.
1110
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.
1116
1117 DEF is anything that can be a key's definition:
1118 nil (means key is undefined in this keymap),
1119 a command (a Lisp function suitable for interactive calling),
1120 a string (treated as a keyboard macro),
1121 a keymap (to define a prefix key),
1122 a symbol (when the key is looked up, the symbol will stand for its
1123 function definition, which should at that time be one of the above,
1124 or another symbol whose function definition is used, etc.),
1125 a cons (STRING . DEFN), meaning that DEFN is the definition
1126 (DEFN should be a valid definition in its own right),
1127 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1128 or an extended menu item definition.
1129 (See info node `(elisp)Extended Menu Items'.)
1130
1131 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1132 binding is altered. If there is no binding for KEY, the new pair
1133 binding KEY to DEF is added at the front of KEYMAP. */)
1134 (keymap, key, def)
1135 Lisp_Object keymap;
1136 Lisp_Object key;
1137 Lisp_Object def;
1138 {
1139 register int idx;
1140 register Lisp_Object c;
1141 register Lisp_Object cmd;
1142 int metized = 0;
1143 int meta_bit;
1144 int length;
1145 struct gcpro gcpro1, gcpro2, gcpro3;
1146
1147 GCPRO3 (keymap, key, def);
1148 keymap = get_keymap (keymap, 1, 1);
1149
1150 CHECK_VECTOR_OR_STRING (key);
1151
1152 length = XFASTINT (Flength (key));
1153 if (length == 0)
1154 RETURN_UNGCPRO (Qnil);
1155
1156 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1157 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1158
1159 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1160 ? meta_modifier : 0x80);
1161
1162 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1163 { /* DEF is apparently an XEmacs-style keyboard macro. */
1164 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1165 int i = ASIZE (def);
1166 while (--i >= 0)
1167 {
1168 Lisp_Object c = AREF (def, i);
1169 if (CONSP (c) && lucid_event_type_list_p (c))
1170 c = Fevent_convert_list (c);
1171 ASET (tmp, i, c);
1172 }
1173 def = tmp;
1174 }
1175
1176 idx = 0;
1177 while (1)
1178 {
1179 c = Faref (key, make_number (idx));
1180
1181 if (CONSP (c) && lucid_event_type_list_p (c))
1182 c = Fevent_convert_list (c);
1183
1184 if (SYMBOLP (c))
1185 silly_event_symbol_error (c);
1186
1187 if (INTEGERP (c)
1188 && (XINT (c) & meta_bit)
1189 && !metized)
1190 {
1191 c = meta_prefix_char;
1192 metized = 1;
1193 }
1194 else
1195 {
1196 if (INTEGERP (c))
1197 XSETINT (c, XINT (c) & ~meta_bit);
1198
1199 metized = 0;
1200 idx++;
1201 }
1202
1203 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1204 error ("Key sequence contains invalid event");
1205
1206 if (idx == length)
1207 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1208
1209 cmd = access_keymap (keymap, c, 0, 1, 1);
1210
1211 /* If this key is undefined, make it a prefix. */
1212 if (NILP (cmd))
1213 cmd = define_as_prefix (keymap, c);
1214
1215 keymap = get_keymap (cmd, 0, 1);
1216 if (!CONSP (keymap))
1217 /* We must use Fkey_description rather than just passing key to
1218 error; key might be a vector, not a string. */
1219 error ("Key sequence %s starts with non-prefix key %s",
1220 SDATA (Fkey_description (key, Qnil)),
1221 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1222 make_number (idx)),
1223 Qnil)));
1224 }
1225 }
1226
1227 /* This function may GC (it calls Fkey_binding). */
1228
1229 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1230 doc: /* Return the remapping for command COMMAND.
1231 Returns nil if COMMAND is not remapped (or not a symbol).
1232
1233 If the optional argument POSITION is non-nil, it specifies a mouse
1234 position as returned by `event-start' and `event-end', and the
1235 remapping occurs in the keymaps associated with it. It can also be a
1236 number or marker, in which case the keymap properties at the specified
1237 buffer position instead of point are used. The KEYMAPS argument is
1238 ignored if POSITION is non-nil.
1239
1240 If the optional argument KEYMAPS is non-nil, it should be a list of
1241 keymaps to search for command remapping. Otherwise, search for the
1242 remapping in all currently active keymaps. */)
1243 (command, position, keymaps)
1244 Lisp_Object command, position, keymaps;
1245 {
1246 if (!SYMBOLP (command))
1247 return Qnil;
1248
1249 ASET (command_remapping_vector, 1, command);
1250
1251 if (NILP (keymaps))
1252 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1253 else
1254 {
1255 Lisp_Object maps, binding;
1256
1257 for (maps = keymaps; !NILP (maps); maps = Fcdr (maps))
1258 {
1259 binding = Flookup_key (Fcar (maps), command_remapping_vector, Qnil);
1260 if (!NILP (binding) && !INTEGERP (binding))
1261 return binding;
1262 }
1263 return Qnil;
1264 }
1265 }
1266
1267 /* Value is number if KEY is too long; nil if valid but has no definition. */
1268 /* GC is possible in this function if it autoloads a keymap. */
1269
1270 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1271 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1272 A value of nil means undefined. See doc of `define-key'
1273 for kinds of definitions.
1274
1275 A number as value means KEY is "too long";
1276 that is, characters or symbols in it except for the last one
1277 fail to be a valid sequence of prefix characters in KEYMAP.
1278 The number is how many characters at the front of KEY
1279 it takes to reach a non-prefix key.
1280
1281 Normally, `lookup-key' ignores bindings for t, which act as default
1282 bindings, used when nothing else in the keymap applies; this makes it
1283 usable as a general function for probing keymaps. However, if the
1284 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1285 recognize the default bindings, just as `read-key-sequence' does. */)
1286 (keymap, key, accept_default)
1287 Lisp_Object keymap;
1288 Lisp_Object key;
1289 Lisp_Object accept_default;
1290 {
1291 register int idx;
1292 register Lisp_Object cmd;
1293 register Lisp_Object c;
1294 int length;
1295 int t_ok = !NILP (accept_default);
1296 struct gcpro gcpro1, gcpro2;
1297
1298 GCPRO2 (keymap, key);
1299 keymap = get_keymap (keymap, 1, 1);
1300
1301 CHECK_VECTOR_OR_STRING (key);
1302
1303 length = XFASTINT (Flength (key));
1304 if (length == 0)
1305 RETURN_UNGCPRO (keymap);
1306
1307 idx = 0;
1308 while (1)
1309 {
1310 c = Faref (key, make_number (idx++));
1311
1312 if (CONSP (c) && lucid_event_type_list_p (c))
1313 c = Fevent_convert_list (c);
1314
1315 /* Turn the 8th bit of string chars into a meta modifier. */
1316 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1317 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1318
1319 /* Allow string since binding for `menu-bar-select-buffer'
1320 includes the buffer name in the key sequence. */
1321 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1322 error ("Key sequence contains invalid event");
1323
1324 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1325 if (idx == length)
1326 RETURN_UNGCPRO (cmd);
1327
1328 keymap = get_keymap (cmd, 0, 1);
1329 if (!CONSP (keymap))
1330 RETURN_UNGCPRO (make_number (idx));
1331
1332 QUIT;
1333 }
1334 }
1335
1336 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1337 Assume that currently it does not define C at all.
1338 Return the keymap. */
1339
1340 static Lisp_Object
1341 define_as_prefix (keymap, c)
1342 Lisp_Object keymap, c;
1343 {
1344 Lisp_Object cmd;
1345
1346 cmd = Fmake_sparse_keymap (Qnil);
1347 /* If this key is defined as a prefix in an inherited keymap,
1348 make it a prefix in this map, and make its definition
1349 inherit the other prefix definition. */
1350 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1351 store_in_keymap (keymap, c, cmd);
1352
1353 return cmd;
1354 }
1355
1356 /* Append a key to the end of a key sequence. We always make a vector. */
1357
1358 Lisp_Object
1359 append_key (key_sequence, key)
1360 Lisp_Object key_sequence, key;
1361 {
1362 Lisp_Object args[2];
1363
1364 args[0] = key_sequence;
1365
1366 args[1] = Fcons (key, Qnil);
1367 return Fvconcat (2, args);
1368 }
1369
1370 /* Given a event type C which is a symbol,
1371 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1372
1373 static void
1374 silly_event_symbol_error (c)
1375 Lisp_Object c;
1376 {
1377 Lisp_Object parsed, base, name, assoc;
1378 int modifiers;
1379
1380 parsed = parse_modifiers (c);
1381 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1382 base = XCAR (parsed);
1383 name = Fsymbol_name (base);
1384 /* This alist includes elements such as ("RET" . "\\r"). */
1385 assoc = Fassoc (name, exclude_keys);
1386
1387 if (! NILP (assoc))
1388 {
1389 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1390 char *p = new_mods;
1391 Lisp_Object keystring;
1392 if (modifiers & alt_modifier)
1393 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1394 if (modifiers & ctrl_modifier)
1395 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1396 if (modifiers & hyper_modifier)
1397 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1398 if (modifiers & meta_modifier)
1399 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1400 if (modifiers & shift_modifier)
1401 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1402 if (modifiers & super_modifier)
1403 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1404 *p = 0;
1405
1406 c = reorder_modifiers (c);
1407 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1408
1409 error ((modifiers & ~meta_modifier
1410 ? "To bind the key %s, use [?%s], not [%s]"
1411 : "To bind the key %s, use \"%s\", not [%s]"),
1412 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1413 SDATA (SYMBOL_NAME (c)));
1414 }
1415 }
1416 \f
1417 /* Global, local, and minor mode keymap stuff. */
1418
1419 /* We can't put these variables inside current_minor_maps, since under
1420 some systems, static gets macro-defined to be the empty string.
1421 Ickypoo. */
1422 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1423 static int cmm_size = 0;
1424
1425 /* Store a pointer to an array of the currently active minor modes in
1426 *modeptr, a pointer to an array of the keymaps of the currently
1427 active minor modes in *mapptr, and return the number of maps
1428 *mapptr contains.
1429
1430 This function always returns a pointer to the same buffer, and may
1431 free or reallocate it, so if you want to keep it for a long time or
1432 hand it out to lisp code, copy it. This procedure will be called
1433 for every key sequence read, so the nice lispy approach (return a
1434 new assoclist, list, what have you) for each invocation would
1435 result in a lot of consing over time.
1436
1437 If we used xrealloc/xmalloc and ran out of memory, they would throw
1438 back to the command loop, which would try to read a key sequence,
1439 which would call this function again, resulting in an infinite
1440 loop. Instead, we'll use realloc/malloc and silently truncate the
1441 list, let the key sequence be read, and hope some other piece of
1442 code signals the error. */
1443 int
1444 current_minor_maps (modeptr, mapptr)
1445 Lisp_Object **modeptr, **mapptr;
1446 {
1447 int i = 0;
1448 int list_number = 0;
1449 Lisp_Object alist, assoc, var, val;
1450 Lisp_Object emulation_alists;
1451 Lisp_Object lists[2];
1452
1453 emulation_alists = Vemulation_mode_map_alists;
1454 lists[0] = Vminor_mode_overriding_map_alist;
1455 lists[1] = Vminor_mode_map_alist;
1456
1457 for (list_number = 0; list_number < 2; list_number++)
1458 {
1459 if (CONSP (emulation_alists))
1460 {
1461 alist = XCAR (emulation_alists);
1462 emulation_alists = XCDR (emulation_alists);
1463 if (SYMBOLP (alist))
1464 alist = find_symbol_value (alist);
1465 list_number = -1;
1466 }
1467 else
1468 alist = lists[list_number];
1469
1470 for ( ; CONSP (alist); alist = XCDR (alist))
1471 if ((assoc = XCAR (alist), CONSP (assoc))
1472 && (var = XCAR (assoc), SYMBOLP (var))
1473 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1474 && !NILP (val))
1475 {
1476 Lisp_Object temp;
1477
1478 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1479 and also an entry in Vminor_mode_map_alist,
1480 ignore the latter. */
1481 if (list_number == 1)
1482 {
1483 val = assq_no_quit (var, lists[0]);
1484 if (!NILP (val))
1485 continue;
1486 }
1487
1488 if (i >= cmm_size)
1489 {
1490 int newsize, allocsize;
1491 Lisp_Object *newmodes, *newmaps;
1492
1493 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1494 allocsize = newsize * sizeof *newmodes;
1495
1496 /* Use malloc here. See the comment above this function.
1497 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1498 BLOCK_INPUT;
1499 newmodes = (Lisp_Object *) malloc (allocsize);
1500 if (newmodes)
1501 {
1502 if (cmm_modes)
1503 {
1504 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1505 free (cmm_modes);
1506 }
1507 cmm_modes = newmodes;
1508 }
1509
1510 newmaps = (Lisp_Object *) malloc (allocsize);
1511 if (newmaps)
1512 {
1513 if (cmm_maps)
1514 {
1515 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1516 free (cmm_maps);
1517 }
1518 cmm_maps = newmaps;
1519 }
1520 UNBLOCK_INPUT;
1521
1522 if (newmodes == NULL || newmaps == NULL)
1523 break;
1524 cmm_size = newsize;
1525 }
1526
1527 /* Get the keymap definition--or nil if it is not defined. */
1528 temp = Findirect_function (XCDR (assoc), Qt);
1529 if (!NILP (temp))
1530 {
1531 cmm_modes[i] = var;
1532 cmm_maps [i] = temp;
1533 i++;
1534 }
1535 }
1536 }
1537
1538 if (modeptr) *modeptr = cmm_modes;
1539 if (mapptr) *mapptr = cmm_maps;
1540 return i;
1541 }
1542
1543 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1544 0, 2, 0,
1545 doc: /* Return a list of the currently active keymaps.
1546 OLP if non-nil indicates that we should obey `overriding-local-map' and
1547 `overriding-terminal-local-map'. POSITION can specify a click position
1548 like in the respective argument of `key-binding'. */)
1549 (olp, position)
1550 Lisp_Object olp, position;
1551 {
1552 int count = SPECPDL_INDEX ();
1553
1554 Lisp_Object keymaps;
1555
1556 /* If a mouse click position is given, our variables are based on
1557 the buffer clicked on, not the current buffer. So we may have to
1558 switch the buffer here. */
1559
1560 if (CONSP (position))
1561 {
1562 Lisp_Object window;
1563
1564 window = POSN_WINDOW (position);
1565
1566 if (WINDOWP (window)
1567 && BUFFERP (XWINDOW (window)->buffer)
1568 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1569 {
1570 /* Arrange to go back to the original buffer once we're done
1571 processing the key sequence. We don't use
1572 save_excursion_{save,restore} here, in analogy to
1573 `read-key-sequence' to avoid saving point. Maybe this
1574 would not be a problem here, but it is easier to keep
1575 things the same.
1576 */
1577
1578 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1579
1580 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1581 }
1582 }
1583
1584 keymaps = Fcons (current_global_map, Qnil);
1585
1586 if (!NILP (olp))
1587 {
1588 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1589 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1590 /* The doc said that overriding-terminal-local-map should
1591 override overriding-local-map. The code used them both,
1592 but it seems clearer to use just one. rms, jan 2005. */
1593 else if (!NILP (Voverriding_local_map))
1594 keymaps = Fcons (Voverriding_local_map, keymaps);
1595 }
1596 if (NILP (XCDR (keymaps)))
1597 {
1598 Lisp_Object *maps;
1599 int nmaps, i;
1600
1601 Lisp_Object keymap, local_map;
1602 EMACS_INT pt;
1603
1604 pt = INTEGERP (position) ? XINT (position)
1605 : MARKERP (position) ? marker_position (position)
1606 : PT;
1607
1608 /* Get the buffer local maps, possibly overriden by text or
1609 overlay properties */
1610
1611 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1612 keymap = get_local_map (pt, current_buffer, Qkeymap);
1613
1614 if (CONSP (position))
1615 {
1616 Lisp_Object string;
1617
1618 /* For a mouse click, get the local text-property keymap
1619 of the place clicked on, rather than point. */
1620
1621 if (POSN_INBUFFER_P (position))
1622 {
1623 Lisp_Object pos;
1624
1625 pos = POSN_BUFFER_POSN (position);
1626 if (INTEGERP (pos)
1627 && XINT (pos) >= BEG && XINT (pos) <= Z)
1628 {
1629 local_map = get_local_map (XINT (pos),
1630 current_buffer, Qlocal_map);
1631
1632 keymap = get_local_map (XINT (pos),
1633 current_buffer, Qkeymap);
1634 }
1635 }
1636
1637 /* If on a mode line string with a local keymap,
1638 or for a click on a string, i.e. overlay string or a
1639 string displayed via the `display' property,
1640 consider `local-map' and `keymap' properties of
1641 that string. */
1642
1643 if (string = POSN_STRING (position),
1644 (CONSP (string) && STRINGP (XCAR (string))))
1645 {
1646 Lisp_Object pos, map;
1647
1648 pos = XCDR (string);
1649 string = XCAR (string);
1650 if (INTEGERP (pos)
1651 && XINT (pos) >= 0
1652 && XINT (pos) < SCHARS (string))
1653 {
1654 map = Fget_text_property (pos, Qlocal_map, string);
1655 if (!NILP (map))
1656 local_map = map;
1657
1658 map = Fget_text_property (pos, Qkeymap, string);
1659 if (!NILP (map))
1660 keymap = map;
1661 }
1662 }
1663
1664 }
1665
1666 if (!NILP (local_map))
1667 keymaps = Fcons (local_map, keymaps);
1668
1669 /* Now put all the minor mode keymaps on the list. */
1670 nmaps = current_minor_maps (0, &maps);
1671
1672 for (i = --nmaps; i >= 0; i--)
1673 if (!NILP (maps[i]))
1674 keymaps = Fcons (maps[i], keymaps);
1675
1676 if (!NILP (keymap))
1677 keymaps = Fcons (keymap, keymaps);
1678 }
1679
1680 unbind_to (count, Qnil);
1681
1682 return keymaps;
1683 }
1684
1685 /* GC is possible in this function if it autoloads a keymap. */
1686
1687 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1688 doc: /* Return the binding for command KEY in current keymaps.
1689 KEY is a string or vector, a sequence of keystrokes.
1690 The binding is probably a symbol with a function definition.
1691
1692 Normally, `key-binding' ignores bindings for t, which act as default
1693 bindings, used when nothing else in the keymap applies; this makes it
1694 usable as a general function for probing keymaps. However, if the
1695 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1696 recognize the default bindings, just as `read-key-sequence' does.
1697
1698 Like the normal command loop, `key-binding' will remap the command
1699 resulting from looking up KEY by looking up the command in the
1700 current keymaps. However, if the optional third argument NO-REMAP
1701 is non-nil, `key-binding' returns the unmapped command.
1702
1703 If KEY is a key sequence initiated with the mouse, the used keymaps
1704 will depend on the clicked mouse position with regard to the buffer
1705 and possible local keymaps on strings.
1706
1707 If the optional argument POSITION is non-nil, it specifies a mouse
1708 position as returned by `event-start' and `event-end', and the lookup
1709 occurs in the keymaps associated with it instead of KEY. It can also
1710 be a number or marker, in which case the keymap properties at the
1711 specified buffer position instead of point are used.
1712 */)
1713 (key, accept_default, no_remap, position)
1714 Lisp_Object key, accept_default, no_remap, position;
1715 {
1716 Lisp_Object *maps, value;
1717 int nmaps, i;
1718 struct gcpro gcpro1, gcpro2;
1719 int count = SPECPDL_INDEX ();
1720
1721 GCPRO2 (key, position);
1722
1723 if (NILP (position) && VECTORP (key))
1724 {
1725 Lisp_Object event
1726 /* mouse events may have a symbolic prefix indicating the
1727 scrollbar or mode line */
1728 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1729
1730 /* We are not interested in locations without event data */
1731
1732 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1733 {
1734 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1735 if (EQ (kind, Qmouse_click))
1736 position = EVENT_START (event);
1737 }
1738 }
1739
1740 /* Key sequences beginning with mouse clicks
1741 are read using the keymaps of the buffer clicked on, not
1742 the current buffer. So we may have to switch the buffer
1743 here. */
1744
1745 if (CONSP (position))
1746 {
1747 Lisp_Object window;
1748
1749 window = POSN_WINDOW (position);
1750
1751 if (WINDOWP (window)
1752 && BUFFERP (XWINDOW (window)->buffer)
1753 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1754 {
1755 /* Arrange to go back to the original buffer once we're done
1756 processing the key sequence. We don't use
1757 save_excursion_{save,restore} here, in analogy to
1758 `read-key-sequence' to avoid saving point. Maybe this
1759 would not be a problem here, but it is easier to keep
1760 things the same.
1761 */
1762
1763 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1764
1765 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1766 }
1767 }
1768
1769 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1770 {
1771 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1772 key, accept_default);
1773 if (! NILP (value) && !INTEGERP (value))
1774 goto done;
1775 }
1776 else if (! NILP (Voverriding_local_map))
1777 {
1778 value = Flookup_key (Voverriding_local_map, key, accept_default);
1779 if (! NILP (value) && !INTEGERP (value))
1780 goto done;
1781 }
1782 else
1783 {
1784 Lisp_Object keymap, local_map;
1785 EMACS_INT pt;
1786
1787 pt = INTEGERP (position) ? XINT (position)
1788 : MARKERP (position) ? marker_position (position)
1789 : PT;
1790
1791 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1792 keymap = get_local_map (pt, current_buffer, Qkeymap);
1793
1794 if (CONSP (position))
1795 {
1796 Lisp_Object string;
1797
1798 /* For a mouse click, get the local text-property keymap
1799 of the place clicked on, rather than point. */
1800
1801 if (POSN_INBUFFER_P (position))
1802 {
1803 Lisp_Object pos;
1804
1805 pos = POSN_BUFFER_POSN (position);
1806 if (INTEGERP (pos)
1807 && XINT (pos) >= BEG && XINT (pos) <= Z)
1808 {
1809 local_map = get_local_map (XINT (pos),
1810 current_buffer, Qlocal_map);
1811
1812 keymap = get_local_map (XINT (pos),
1813 current_buffer, Qkeymap);
1814 }
1815 }
1816
1817 /* If on a mode line string with a local keymap,
1818 or for a click on a string, i.e. overlay string or a
1819 string displayed via the `display' property,
1820 consider `local-map' and `keymap' properties of
1821 that string. */
1822
1823 if (string = POSN_STRING (position),
1824 (CONSP (string) && STRINGP (XCAR (string))))
1825 {
1826 Lisp_Object pos, map;
1827
1828 pos = XCDR (string);
1829 string = XCAR (string);
1830 if (INTEGERP (pos)
1831 && XINT (pos) >= 0
1832 && XINT (pos) < SCHARS (string))
1833 {
1834 map = Fget_text_property (pos, Qlocal_map, string);
1835 if (!NILP (map))
1836 local_map = map;
1837
1838 map = Fget_text_property (pos, Qkeymap, string);
1839 if (!NILP (map))
1840 keymap = map;
1841 }
1842 }
1843
1844 }
1845
1846 if (! NILP (keymap))
1847 {
1848 value = Flookup_key (keymap, key, accept_default);
1849 if (! NILP (value) && !INTEGERP (value))
1850 goto done;
1851 }
1852
1853 nmaps = current_minor_maps (0, &maps);
1854 /* Note that all these maps are GCPRO'd
1855 in the places where we found them. */
1856
1857 for (i = 0; i < nmaps; i++)
1858 if (! NILP (maps[i]))
1859 {
1860 value = Flookup_key (maps[i], key, accept_default);
1861 if (! NILP (value) && !INTEGERP (value))
1862 goto done;
1863 }
1864
1865 if (! NILP (local_map))
1866 {
1867 value = Flookup_key (local_map, key, accept_default);
1868 if (! NILP (value) && !INTEGERP (value))
1869 goto done;
1870 }
1871 }
1872
1873 value = Flookup_key (current_global_map, key, accept_default);
1874
1875 done:
1876 unbind_to (count, Qnil);
1877
1878 UNGCPRO;
1879 if (NILP (value) || INTEGERP (value))
1880 return Qnil;
1881
1882 /* If the result of the ordinary keymap lookup is an interactive
1883 command, look for a key binding (ie. remapping) for that command. */
1884
1885 if (NILP (no_remap) && SYMBOLP (value))
1886 {
1887 Lisp_Object value1;
1888 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1889 value = value1;
1890 }
1891
1892 return value;
1893 }
1894
1895 /* GC is possible in this function if it autoloads a keymap. */
1896
1897 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1898 doc: /* Return the binding for command KEYS in current local keymap only.
1899 KEYS is a string or vector, a sequence of keystrokes.
1900 The binding is probably a symbol with a function definition.
1901
1902 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1903 bindings; see the description of `lookup-key' for more details about this. */)
1904 (keys, accept_default)
1905 Lisp_Object keys, accept_default;
1906 {
1907 register Lisp_Object map;
1908 map = current_buffer->keymap;
1909 if (NILP (map))
1910 return Qnil;
1911 return Flookup_key (map, keys, accept_default);
1912 }
1913
1914 /* GC is possible in this function if it autoloads a keymap. */
1915
1916 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1917 doc: /* Return the binding for command KEYS in current global keymap only.
1918 KEYS is a string or vector, a sequence of keystrokes.
1919 The binding is probably a symbol with a function definition.
1920 This function's return values are the same as those of `lookup-key'
1921 \(which see).
1922
1923 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1924 bindings; see the description of `lookup-key' for more details about this. */)
1925 (keys, accept_default)
1926 Lisp_Object keys, accept_default;
1927 {
1928 return Flookup_key (current_global_map, keys, accept_default);
1929 }
1930
1931 /* GC is possible in this function if it autoloads a keymap. */
1932
1933 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1934 doc: /* Find the visible minor mode bindings of KEY.
1935 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1936 the symbol which names the minor mode binding KEY, and BINDING is
1937 KEY's definition in that mode. In particular, if KEY has no
1938 minor-mode bindings, return nil. If the first binding is a
1939 non-prefix, all subsequent bindings will be omitted, since they would
1940 be ignored. Similarly, the list doesn't include non-prefix bindings
1941 that come after prefix bindings.
1942
1943 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1944 bindings; see the description of `lookup-key' for more details about this. */)
1945 (key, accept_default)
1946 Lisp_Object key, accept_default;
1947 {
1948 Lisp_Object *modes, *maps;
1949 int nmaps;
1950 Lisp_Object binding;
1951 int i, j;
1952 struct gcpro gcpro1, gcpro2;
1953
1954 nmaps = current_minor_maps (&modes, &maps);
1955 /* Note that all these maps are GCPRO'd
1956 in the places where we found them. */
1957
1958 binding = Qnil;
1959 GCPRO2 (key, binding);
1960
1961 for (i = j = 0; i < nmaps; i++)
1962 if (!NILP (maps[i])
1963 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1964 && !INTEGERP (binding))
1965 {
1966 if (KEYMAPP (binding))
1967 maps[j++] = Fcons (modes[i], binding);
1968 else if (j == 0)
1969 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1970 }
1971
1972 UNGCPRO;
1973 return Flist (j, maps);
1974 }
1975
1976 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1977 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1978 A new sparse keymap is stored as COMMAND's function definition and its value.
1979 If a second optional argument MAPVAR is given, the map is stored as
1980 its value instead of as COMMAND's value; but COMMAND is still defined
1981 as a function.
1982 The third optional argument NAME, if given, supplies a menu name
1983 string for the map. This is required to use the keymap as a menu.
1984 This function returns COMMAND. */)
1985 (command, mapvar, name)
1986 Lisp_Object command, mapvar, name;
1987 {
1988 Lisp_Object map;
1989 map = Fmake_sparse_keymap (name);
1990 Ffset (command, map);
1991 if (!NILP (mapvar))
1992 Fset (mapvar, map);
1993 else
1994 Fset (command, map);
1995 return command;
1996 }
1997
1998 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1999 doc: /* Select KEYMAP as the global keymap. */)
2000 (keymap)
2001 Lisp_Object keymap;
2002 {
2003 keymap = get_keymap (keymap, 1, 1);
2004 current_global_map = keymap;
2005
2006 return Qnil;
2007 }
2008
2009 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2010 doc: /* Select KEYMAP as the local keymap.
2011 If KEYMAP is nil, that means no local keymap. */)
2012 (keymap)
2013 Lisp_Object keymap;
2014 {
2015 if (!NILP (keymap))
2016 keymap = get_keymap (keymap, 1, 1);
2017
2018 current_buffer->keymap = keymap;
2019
2020 return Qnil;
2021 }
2022
2023 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2024 doc: /* Return current buffer's local keymap, or nil if it has none. */)
2025 ()
2026 {
2027 return current_buffer->keymap;
2028 }
2029
2030 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2031 doc: /* Return the current global keymap. */)
2032 ()
2033 {
2034 return current_global_map;
2035 }
2036
2037 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2038 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2039 ()
2040 {
2041 Lisp_Object *maps;
2042 int nmaps = current_minor_maps (0, &maps);
2043
2044 return Flist (nmaps, maps);
2045 }
2046 \f
2047 /* Help functions for describing and documenting keymaps. */
2048
2049 struct accessible_keymaps_data {
2050 Lisp_Object maps, tail, thisseq;
2051 /* Does the current sequence end in the meta-prefix-char? */
2052 int is_metized;
2053 };
2054
2055 static void
2056 accessible_keymaps_1 (key, cmd, args, data)
2057 Lisp_Object key, cmd, args;
2058 /* Use void* to be compatible with map_keymap_function_t. */
2059 void *data;
2060 {
2061 struct accessible_keymaps_data *d = data; /* Cast! */
2062 Lisp_Object maps = d->maps;
2063 Lisp_Object tail = d->tail;
2064 Lisp_Object thisseq = d->thisseq;
2065 int is_metized = d->is_metized && INTEGERP (key);
2066 Lisp_Object tem;
2067
2068 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2069 if (NILP (cmd))
2070 return;
2071
2072 /* Look for and break cycles. */
2073 while (!NILP (tem = Frassq (cmd, maps)))
2074 {
2075 Lisp_Object prefix = XCAR (tem);
2076 int lim = XINT (Flength (XCAR (tem)));
2077 if (lim <= XINT (Flength (thisseq)))
2078 { /* This keymap was already seen with a smaller prefix. */
2079 int i = 0;
2080 while (i < lim && EQ (Faref (prefix, make_number (i)),
2081 Faref (thisseq, make_number (i))))
2082 i++;
2083 if (i >= lim)
2084 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2085 return;
2086 }
2087 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2088 but maybe `cmd' occurs again further down in `maps', so keep
2089 looking. */
2090 maps = XCDR (Fmemq (tem, maps));
2091 }
2092
2093 /* If the last key in thisseq is meta-prefix-char,
2094 turn it into a meta-ized keystroke. We know
2095 that the event we're about to append is an
2096 ascii keystroke since we're processing a
2097 keymap table. */
2098 if (is_metized)
2099 {
2100 int meta_bit = meta_modifier;
2101 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2102 tem = Fcopy_sequence (thisseq);
2103
2104 Faset (tem, last, make_number (XINT (key) | meta_bit));
2105
2106 /* This new sequence is the same length as
2107 thisseq, so stick it in the list right
2108 after this one. */
2109 XSETCDR (tail,
2110 Fcons (Fcons (tem, cmd), XCDR (tail)));
2111 }
2112 else
2113 {
2114 tem = append_key (thisseq, key);
2115 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2116 }
2117 }
2118
2119 /* This function cannot GC. */
2120
2121 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2122 1, 2, 0,
2123 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2124 Returns a list of elements of the form (KEYS . MAP), where the sequence
2125 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2126 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2127 An optional argument PREFIX, if non-nil, should be a key sequence;
2128 then the value includes only maps for prefixes that start with PREFIX. */)
2129 (keymap, prefix)
2130 Lisp_Object keymap, prefix;
2131 {
2132 Lisp_Object maps, tail;
2133 int prefixlen = XINT (Flength (prefix));
2134
2135 /* no need for gcpro because we don't autoload any keymaps. */
2136
2137 if (!NILP (prefix))
2138 {
2139 /* If a prefix was specified, start with the keymap (if any) for
2140 that prefix, so we don't waste time considering other prefixes. */
2141 Lisp_Object tem;
2142 tem = Flookup_key (keymap, prefix, Qt);
2143 /* Flookup_key may give us nil, or a number,
2144 if the prefix is not defined in this particular map.
2145 It might even give us a list that isn't a keymap. */
2146 tem = get_keymap (tem, 0, 0);
2147 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2148 want to return it. */
2149 if (!NILP (tem))
2150 {
2151 /* Convert PREFIX to a vector now, so that later on
2152 we don't have to deal with the possibility of a string. */
2153 if (STRINGP (prefix))
2154 {
2155 int i, i_byte, c;
2156 Lisp_Object copy;
2157
2158 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2159 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2160 {
2161 int i_before = i;
2162
2163 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2164 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2165 c ^= 0200 | meta_modifier;
2166 ASET (copy, i_before, make_number (c));
2167 }
2168 prefix = copy;
2169 }
2170 maps = Fcons (Fcons (prefix, tem), Qnil);
2171 }
2172 else
2173 return Qnil;
2174 }
2175 else
2176 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2177 get_keymap (keymap, 1, 0)),
2178 Qnil);
2179
2180 /* For each map in the list maps,
2181 look at any other maps it points to,
2182 and stick them at the end if they are not already in the list.
2183
2184 This is a breadth-first traversal, where tail is the queue of
2185 nodes, and maps accumulates a list of all nodes visited. */
2186
2187 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2188 {
2189 struct accessible_keymaps_data data;
2190 register Lisp_Object thismap = Fcdr (XCAR (tail));
2191 Lisp_Object last;
2192
2193 data.thisseq = Fcar (XCAR (tail));
2194 data.maps = maps;
2195 data.tail = tail;
2196 last = make_number (XINT (Flength (data.thisseq)) - 1);
2197 /* Does the current sequence end in the meta-prefix-char? */
2198 data.is_metized = (XINT (last) >= 0
2199 /* Don't metize the last char of PREFIX. */
2200 && XINT (last) >= prefixlen
2201 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2202
2203 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2204 if (CONSP (thismap))
2205 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2206 }
2207 return maps;
2208 }
2209 Lisp_Object Qsingle_key_description, Qkey_description;
2210
2211 /* This function cannot GC. */
2212
2213 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2214 doc: /* Return a pretty description of key-sequence KEYS.
2215 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2216 Control characters turn into "C-foo" sequences, meta into "M-foo",
2217 spaces are put between sequence elements, etc. */)
2218 (keys, prefix)
2219 Lisp_Object keys, prefix;
2220 {
2221 int len = 0;
2222 int i, i_byte;
2223 Lisp_Object *args;
2224 int size = XINT (Flength (keys));
2225 Lisp_Object list;
2226 Lisp_Object sep = build_string (" ");
2227 Lisp_Object key;
2228 int add_meta = 0;
2229
2230 if (!NILP (prefix))
2231 size += XINT (Flength (prefix));
2232
2233 /* This has one extra element at the end that we don't pass to Fconcat. */
2234 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2235
2236 /* In effect, this computes
2237 (mapconcat 'single-key-description keys " ")
2238 but we shouldn't use mapconcat because it can do GC. */
2239
2240 next_list:
2241 if (!NILP (prefix))
2242 list = prefix, prefix = Qnil;
2243 else if (!NILP (keys))
2244 list = keys, keys = Qnil;
2245 else
2246 {
2247 if (add_meta)
2248 {
2249 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2250 len += 2;
2251 }
2252 else if (len == 0)
2253 return empty_unibyte_string;
2254 return Fconcat (len - 1, args);
2255 }
2256
2257 if (STRINGP (list))
2258 size = SCHARS (list);
2259 else if (VECTORP (list))
2260 size = XVECTOR (list)->size;
2261 else if (CONSP (list))
2262 size = XINT (Flength (list));
2263 else
2264 wrong_type_argument (Qarrayp, list);
2265
2266 i = i_byte = 0;
2267
2268 while (i < size)
2269 {
2270 if (STRINGP (list))
2271 {
2272 int c;
2273 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2274 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2275 c ^= 0200 | meta_modifier;
2276 XSETFASTINT (key, c);
2277 }
2278 else if (VECTORP (list))
2279 {
2280 key = AREF (list, i++);
2281 }
2282 else
2283 {
2284 key = XCAR (list);
2285 list = XCDR (list);
2286 i++;
2287 }
2288
2289 if (add_meta)
2290 {
2291 if (!INTEGERP (key)
2292 || EQ (key, meta_prefix_char)
2293 || (XINT (key) & meta_modifier))
2294 {
2295 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2296 args[len++] = sep;
2297 if (EQ (key, meta_prefix_char))
2298 continue;
2299 }
2300 else
2301 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2302 add_meta = 0;
2303 }
2304 else if (EQ (key, meta_prefix_char))
2305 {
2306 add_meta = 1;
2307 continue;
2308 }
2309 args[len++] = Fsingle_key_description (key, Qnil);
2310 args[len++] = sep;
2311 }
2312 goto next_list;
2313 }
2314
2315
2316 char *
2317 push_key_description (c, p, force_multibyte)
2318 register unsigned int c;
2319 register char *p;
2320 int force_multibyte;
2321 {
2322 unsigned c2;
2323 int valid_p;
2324
2325 /* Clear all the meaningless bits above the meta bit. */
2326 c &= meta_modifier | ~ - meta_modifier;
2327 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2328 | meta_modifier | shift_modifier | super_modifier);
2329
2330 valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2331 if (! valid_p)
2332 {
2333 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2334 p += sprintf (p, "[%d]", c);
2335 return p;
2336 }
2337
2338 if (c & alt_modifier)
2339 {
2340 *p++ = 'A';
2341 *p++ = '-';
2342 c -= alt_modifier;
2343 }
2344 if ((c & ctrl_modifier) != 0
2345 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2346 {
2347 *p++ = 'C';
2348 *p++ = '-';
2349 c &= ~ctrl_modifier;
2350 }
2351 if (c & hyper_modifier)
2352 {
2353 *p++ = 'H';
2354 *p++ = '-';
2355 c -= hyper_modifier;
2356 }
2357 if (c & meta_modifier)
2358 {
2359 *p++ = 'M';
2360 *p++ = '-';
2361 c -= meta_modifier;
2362 }
2363 if (c & shift_modifier)
2364 {
2365 *p++ = 'S';
2366 *p++ = '-';
2367 c -= shift_modifier;
2368 }
2369 if (c & super_modifier)
2370 {
2371 *p++ = 's';
2372 *p++ = '-';
2373 c -= super_modifier;
2374 }
2375 if (c < 040)
2376 {
2377 if (c == 033)
2378 {
2379 *p++ = 'E';
2380 *p++ = 'S';
2381 *p++ = 'C';
2382 }
2383 else if (c == '\t')
2384 {
2385 *p++ = 'T';
2386 *p++ = 'A';
2387 *p++ = 'B';
2388 }
2389 else if (c == Ctl ('M'))
2390 {
2391 *p++ = 'R';
2392 *p++ = 'E';
2393 *p++ = 'T';
2394 }
2395 else
2396 {
2397 /* `C-' already added above. */
2398 if (c > 0 && c <= Ctl ('Z'))
2399 *p++ = c + 0140;
2400 else
2401 *p++ = c + 0100;
2402 }
2403 }
2404 else if (c == 0177)
2405 {
2406 *p++ = 'D';
2407 *p++ = 'E';
2408 *p++ = 'L';
2409 }
2410 else if (c == ' ')
2411 {
2412 *p++ = 'S';
2413 *p++ = 'P';
2414 *p++ = 'C';
2415 }
2416 else if (c < 128
2417 || (NILP (current_buffer->enable_multibyte_characters)
2418 && SINGLE_BYTE_CHAR_P (c)
2419 && !force_multibyte))
2420 {
2421 *p++ = c;
2422 }
2423 else
2424 {
2425 if (force_multibyte)
2426 {
2427 if (SINGLE_BYTE_CHAR_P (c))
2428 c = unibyte_char_to_multibyte (c);
2429 p += CHAR_STRING (c, p);
2430 }
2431 else if (NILP (current_buffer->enable_multibyte_characters))
2432 {
2433 int bit_offset;
2434 *p++ = '\\';
2435 /* The biggest character code uses 19 bits. */
2436 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2437 {
2438 if (c >= (1 << bit_offset))
2439 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2440 }
2441 }
2442 else
2443 p += CHAR_STRING (c, p);
2444 }
2445
2446 return p;
2447 }
2448
2449 /* This function cannot GC. */
2450
2451 DEFUN ("single-key-description", Fsingle_key_description,
2452 Ssingle_key_description, 1, 2, 0,
2453 doc: /* Return a pretty description of command character KEY.
2454 Control characters turn into C-whatever, etc.
2455 Optional argument NO-ANGLES non-nil means don't put angle brackets
2456 around function keys and event symbols. */)
2457 (key, no_angles)
2458 Lisp_Object key, no_angles;
2459 {
2460 if (CONSP (key) && lucid_event_type_list_p (key))
2461 key = Fevent_convert_list (key);
2462
2463 key = EVENT_HEAD (key);
2464
2465 if (INTEGERP (key)) /* Normal character */
2466 {
2467 unsigned int charset, c1, c2;
2468 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2469
2470 if (SINGLE_BYTE_CHAR_P (without_bits))
2471 charset = 0;
2472 else
2473 SPLIT_CHAR (without_bits, charset, c1, c2);
2474
2475 if (! CHAR_VALID_P (without_bits, 1))
2476 {
2477 char buf[256];
2478
2479 sprintf (buf, "Invalid char code %ld", XINT (key));
2480 return build_string (buf);
2481 }
2482 else if (charset
2483 && ((c1 == 0 && c2 == -1) || c2 == 0))
2484 {
2485 /* Handle a generic character. */
2486 Lisp_Object name;
2487 char buf[256];
2488
2489 name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2490 CHECK_STRING (name);
2491 if (c1 == 0)
2492 /* Only a charset is specified. */
2493 sprintf (buf, "Generic char %d: all of ", without_bits);
2494 else
2495 /* 1st code-point of 2-dimensional charset is specified. */
2496 sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2497 return concat2 (build_string (buf), name);
2498 }
2499 else
2500 {
2501 char tem[KEY_DESCRIPTION_SIZE], *end;
2502 int nbytes, nchars;
2503 Lisp_Object string;
2504
2505 end = push_key_description (XUINT (key), tem, 1);
2506 nbytes = end - tem;
2507 nchars = multibyte_chars_in_text (tem, nbytes);
2508 if (nchars == nbytes)
2509 {
2510 *end = '\0';
2511 string = build_string (tem);
2512 }
2513 else
2514 string = make_multibyte_string (tem, nchars, nbytes);
2515 return string;
2516 }
2517 }
2518 else if (SYMBOLP (key)) /* Function key or event-symbol */
2519 {
2520 if (NILP (no_angles))
2521 {
2522 char *buffer
2523 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2524 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2525 return build_string (buffer);
2526 }
2527 else
2528 return Fsymbol_name (key);
2529 }
2530 else if (STRINGP (key)) /* Buffer names in the menubar. */
2531 return Fcopy_sequence (key);
2532 else
2533 error ("KEY must be an integer, cons, symbol, or string");
2534 return Qnil;
2535 }
2536
2537 char *
2538 push_text_char_description (c, p)
2539 register unsigned int c;
2540 register char *p;
2541 {
2542 if (c >= 0200)
2543 {
2544 *p++ = 'M';
2545 *p++ = '-';
2546 c -= 0200;
2547 }
2548 if (c < 040)
2549 {
2550 *p++ = '^';
2551 *p++ = c + 64; /* 'A' - 1 */
2552 }
2553 else if (c == 0177)
2554 {
2555 *p++ = '^';
2556 *p++ = '?';
2557 }
2558 else
2559 *p++ = c;
2560 return p;
2561 }
2562
2563 /* This function cannot GC. */
2564
2565 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2566 doc: /* Return a pretty description of file-character CHARACTER.
2567 Control characters turn into "^char", etc. This differs from
2568 `single-key-description' which turns them into "C-char".
2569 Also, this function recognizes the 2**7 bit as the Meta character,
2570 whereas `single-key-description' uses the 2**27 bit for Meta.
2571 See Info node `(elisp)Describing Characters' for examples. */)
2572 (character)
2573 Lisp_Object character;
2574 {
2575 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2576 unsigned char str[6];
2577 int c;
2578
2579 CHECK_NUMBER (character);
2580
2581 c = XINT (character);
2582 if (!SINGLE_BYTE_CHAR_P (c))
2583 {
2584 int len = CHAR_STRING (c, str);
2585
2586 return make_multibyte_string (str, 1, len);
2587 }
2588
2589 *push_text_char_description (c & 0377, str) = 0;
2590
2591 return build_string (str);
2592 }
2593
2594 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2595 a meta bit. */
2596 static int
2597 ascii_sequence_p (seq)
2598 Lisp_Object seq;
2599 {
2600 int i;
2601 int len = XINT (Flength (seq));
2602
2603 for (i = 0; i < len; i++)
2604 {
2605 Lisp_Object ii, elt;
2606
2607 XSETFASTINT (ii, i);
2608 elt = Faref (seq, ii);
2609
2610 if (!INTEGERP (elt)
2611 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2612 return 0;
2613 }
2614
2615 return 1;
2616 }
2617
2618 \f
2619 /* where-is - finding a command in a set of keymaps. */
2620
2621 static Lisp_Object where_is_internal ();
2622 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2623 Lisp_Object args, void *data));
2624
2625 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2626 Returns the first non-nil binding found in any of those maps. */
2627
2628 static Lisp_Object
2629 shadow_lookup (shadow, key, flag)
2630 Lisp_Object shadow, key, flag;
2631 {
2632 Lisp_Object tail, value;
2633
2634 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2635 {
2636 value = Flookup_key (XCAR (tail), key, flag);
2637 if (NATNUMP (value))
2638 {
2639 value = Flookup_key (XCAR (tail),
2640 Fsubstring (key, make_number (0), value), flag);
2641 if (!NILP (value))
2642 return Qnil;
2643 }
2644 else if (!NILP (value))
2645 return value;
2646 }
2647 return Qnil;
2648 }
2649
2650 static Lisp_Object Vmouse_events;
2651
2652 struct where_is_internal_data {
2653 Lisp_Object definition, noindirect, this, last;
2654 int last_is_meta;
2655 Lisp_Object sequences;
2656 };
2657
2658 /* This function can GC if Flookup_key autoloads any keymaps. */
2659
2660 static Lisp_Object
2661 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2662 Lisp_Object definition, keymaps;
2663 Lisp_Object firstonly, noindirect, no_remap;
2664 {
2665 Lisp_Object maps = Qnil;
2666 Lisp_Object found, sequences;
2667 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2668 /* 1 means ignore all menu bindings entirely. */
2669 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2670
2671 found = keymaps;
2672 while (CONSP (found))
2673 {
2674 maps =
2675 nconc2 (maps,
2676 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2677 found = XCDR (found);
2678 }
2679
2680 GCPRO5 (definition, keymaps, maps, found, sequences);
2681 found = Qnil;
2682 sequences = Qnil;
2683
2684 /* If this command is remapped, then it has no key bindings
2685 of its own. */
2686 if (NILP (no_remap)
2687 && SYMBOLP (definition)
2688 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2689 RETURN_UNGCPRO (Qnil);
2690
2691 for (; !NILP (maps); maps = Fcdr (maps))
2692 {
2693 /* Key sequence to reach map, and the map that it reaches */
2694 register Lisp_Object this, map, tem;
2695 struct where_is_internal_data data;
2696
2697 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2698 [M-CHAR] sequences, check if last character of the sequence
2699 is the meta-prefix char. */
2700 Lisp_Object last;
2701 int last_is_meta;
2702
2703 this = Fcar (Fcar (maps));
2704 map = Fcdr (Fcar (maps));
2705 last = make_number (XINT (Flength (this)) - 1);
2706 last_is_meta = (XINT (last) >= 0
2707 && EQ (Faref (this, last), meta_prefix_char));
2708
2709 /* if (nomenus && !ascii_sequence_p (this)) */
2710 if (nomenus && XINT (last) >= 0
2711 && SYMBOLP (tem = Faref (this, make_number (0)))
2712 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2713 /* If no menu entries should be returned, skip over the
2714 keymaps bound to `menu-bar' and `tool-bar' and other
2715 non-ascii prefixes like `C-down-mouse-2'. */
2716 continue;
2717
2718 QUIT;
2719
2720 data.definition = definition;
2721 data.noindirect = noindirect;
2722 data.this = this;
2723 data.last = last;
2724 data.last_is_meta = last_is_meta;
2725 data.sequences = Qnil;
2726
2727 if (CONSP (map))
2728 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2729
2730 sequences = data.sequences;
2731
2732 while (CONSP (sequences))
2733 {
2734 Lisp_Object sequence, remapped, function;
2735
2736 sequence = XCAR (sequences);
2737 sequences = XCDR (sequences);
2738
2739 /* If the current sequence is a command remapping with
2740 format [remap COMMAND], find the key sequences
2741 which run COMMAND, and use those sequences instead. */
2742 remapped = Qnil;
2743 if (NILP (no_remap)
2744 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2745 && EQ (AREF (sequence, 0), Qremap)
2746 && (function = AREF (sequence, 1), SYMBOLP (function)))
2747 {
2748 Lisp_Object remapped1;
2749
2750 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2751 if (CONSP (remapped1))
2752 {
2753 /* Verify that this key binding actually maps to the
2754 remapped command (see below). */
2755 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2756 continue;
2757 sequence = XCAR (remapped1);
2758 remapped = XCDR (remapped1);
2759 goto record_sequence;
2760 }
2761 }
2762
2763 /* Verify that this key binding is not shadowed by another
2764 binding for the same key, before we say it exists.
2765
2766 Mechanism: look for local definition of this key and if
2767 it is defined and does not match what we found then
2768 ignore this key.
2769
2770 Either nil or number as value from Flookup_key
2771 means undefined. */
2772 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2773 continue;
2774
2775 record_sequence:
2776 /* Don't annoy user with strings from a menu such as
2777 Select Paste. Change them all to "(any string)",
2778 so that there seems to be only one menu item
2779 to report. */
2780 if (! NILP (sequence))
2781 {
2782 Lisp_Object tem;
2783 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2784 if (STRINGP (tem))
2785 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2786 build_string ("(any string)"));
2787 }
2788
2789 /* It is a true unshadowed match. Record it, unless it's already
2790 been seen (as could happen when inheriting keymaps). */
2791 if (NILP (Fmember (sequence, found)))
2792 found = Fcons (sequence, found);
2793
2794 /* If firstonly is Qnon_ascii, then we can return the first
2795 binding we find. If firstonly is not Qnon_ascii but not
2796 nil, then we should return the first ascii-only binding
2797 we find. */
2798 if (EQ (firstonly, Qnon_ascii))
2799 RETURN_UNGCPRO (sequence);
2800 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2801 RETURN_UNGCPRO (sequence);
2802
2803 if (CONSP (remapped))
2804 {
2805 sequence = XCAR (remapped);
2806 remapped = XCDR (remapped);
2807 goto record_sequence;
2808 }
2809 }
2810 }
2811
2812 UNGCPRO;
2813
2814 found = Fnreverse (found);
2815
2816 /* firstonly may have been t, but we may have gone all the way through
2817 the keymaps without finding an all-ASCII key sequence. So just
2818 return the best we could find. */
2819 if (!NILP (firstonly))
2820 return Fcar (found);
2821
2822 return found;
2823 }
2824
2825 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2826 doc: /* Return list of keys that invoke DEFINITION.
2827 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2828 If KEYMAP is nil, search all the currently active keymaps.
2829 If KEYMAP is a list of keymaps, search only those keymaps.
2830
2831 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2832 rather than a list of all possible key sequences.
2833 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2834 no matter what it is.
2835 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2836 \(or their meta variants) and entirely reject menu bindings.
2837
2838 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2839 to other keymaps or slots. This makes it possible to search for an
2840 indirect definition itself.
2841
2842 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2843 that invoke a command which is remapped to DEFINITION, but include the
2844 remapped command in the returned list. */)
2845 (definition, keymap, firstonly, noindirect, no_remap)
2846 Lisp_Object definition, keymap;
2847 Lisp_Object firstonly, noindirect, no_remap;
2848 {
2849 Lisp_Object sequences, keymaps;
2850 /* 1 means ignore all menu bindings entirely. */
2851 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2852 Lisp_Object result;
2853
2854 /* Find the relevant keymaps. */
2855 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2856 keymaps = keymap;
2857 else if (!NILP (keymap))
2858 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2859 else
2860 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2861
2862 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2863 We don't really need to check `keymap'. */
2864 if (nomenus && NILP (noindirect) && NILP (keymap))
2865 {
2866 Lisp_Object *defns;
2867 int i, j, n;
2868 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2869
2870 /* Check heuristic-consistency of the cache. */
2871 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2872 where_is_cache = Qnil;
2873
2874 if (NILP (where_is_cache))
2875 {
2876 /* We need to create the cache. */
2877 Lisp_Object args[2];
2878 where_is_cache = Fmake_hash_table (0, args);
2879 where_is_cache_keymaps = Qt;
2880
2881 /* Fill in the cache. */
2882 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2883 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2884 UNGCPRO;
2885
2886 where_is_cache_keymaps = keymaps;
2887 }
2888
2889 /* We want to process definitions from the last to the first.
2890 Instead of consing, copy definitions to a vector and step
2891 over that vector. */
2892 sequences = Fgethash (definition, where_is_cache, Qnil);
2893 n = XINT (Flength (sequences));
2894 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2895 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2896 defns[i++] = XCAR (sequences);
2897
2898 /* Verify that the key bindings are not shadowed. Note that
2899 the following can GC. */
2900 GCPRO2 (definition, keymaps);
2901 result = Qnil;
2902 j = -1;
2903 for (i = n - 1; i >= 0; --i)
2904 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2905 {
2906 if (ascii_sequence_p (defns[i]))
2907 break;
2908 else if (j < 0)
2909 j = i;
2910 }
2911
2912 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2913 UNGCPRO;
2914 }
2915 else
2916 {
2917 /* Kill the cache so that where_is_internal_1 doesn't think
2918 we're filling it up. */
2919 where_is_cache = Qnil;
2920 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2921 }
2922
2923 return result;
2924 }
2925
2926 /* This function can GC because get_keyelt can. */
2927
2928 static void
2929 where_is_internal_1 (key, binding, args, data)
2930 Lisp_Object key, binding, args;
2931 void *data;
2932 {
2933 struct where_is_internal_data *d = data; /* Cast! */
2934 Lisp_Object definition = d->definition;
2935 Lisp_Object noindirect = d->noindirect;
2936 Lisp_Object this = d->this;
2937 Lisp_Object last = d->last;
2938 int last_is_meta = d->last_is_meta;
2939 Lisp_Object sequence;
2940
2941 /* Search through indirections unless that's not wanted. */
2942 if (NILP (noindirect))
2943 binding = get_keyelt (binding, 0);
2944
2945 /* End this iteration if this element does not match
2946 the target. */
2947
2948 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2949 || EQ (binding, definition)
2950 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2951 /* Doesn't match. */
2952 return;
2953
2954 /* We have found a match. Construct the key sequence where we found it. */
2955 if (INTEGERP (key) && last_is_meta)
2956 {
2957 sequence = Fcopy_sequence (this);
2958 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2959 }
2960 else
2961 sequence = append_key (this, key);
2962
2963 if (!NILP (where_is_cache))
2964 {
2965 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2966 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2967 }
2968 else
2969 d->sequences = Fcons (sequence, d->sequences);
2970 }
2971 \f
2972 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2973
2974 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2975 doc: /* Insert the list of all defined keys and their definitions.
2976 The list is inserted in the current buffer, while the bindings are
2977 looked up in BUFFER.
2978 The optional argument PREFIX, if non-nil, should be a key sequence;
2979 then we display only bindings that start with that prefix.
2980 The optional argument MENUS, if non-nil, says to mention menu bindings.
2981 \(Ordinarily these are omitted from the output.) */)
2982 (buffer, prefix, menus)
2983 Lisp_Object buffer, prefix, menus;
2984 {
2985 Lisp_Object outbuf, shadow;
2986 int nomenu = NILP (menus);
2987 register Lisp_Object start1;
2988 struct gcpro gcpro1;
2989
2990 char *alternate_heading
2991 = "\
2992 Keyboard translations:\n\n\
2993 You type Translation\n\
2994 -------- -----------\n";
2995
2996 CHECK_BUFFER (buffer);
2997
2998 shadow = Qnil;
2999 GCPRO1 (shadow);
3000
3001 outbuf = Fcurrent_buffer ();
3002
3003 /* Report on alternates for keys. */
3004 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
3005 {
3006 int c;
3007 const unsigned char *translate = SDATA (Vkeyboard_translate_table);
3008 int translate_len = SCHARS (Vkeyboard_translate_table);
3009
3010 for (c = 0; c < translate_len; c++)
3011 if (translate[c] != c)
3012 {
3013 char buf[KEY_DESCRIPTION_SIZE];
3014 char *bufend;
3015
3016 if (alternate_heading)
3017 {
3018 insert_string (alternate_heading);
3019 alternate_heading = 0;
3020 }
3021
3022 bufend = push_key_description (translate[c], buf, 1);
3023 insert (buf, bufend - buf);
3024 Findent_to (make_number (16), make_number (1));
3025 bufend = push_key_description (c, buf, 1);
3026 insert (buf, bufend - buf);
3027
3028 insert ("\n", 1);
3029
3030 /* Insert calls signal_after_change which may GC. */
3031 translate = SDATA (Vkeyboard_translate_table);
3032 }
3033
3034 insert ("\n", 1);
3035 }
3036
3037 if (!NILP (Vkey_translation_map))
3038 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3039 "Key translations", nomenu, 1, 0, 0);
3040
3041
3042 /* Print the (major mode) local map. */
3043 start1 = Qnil;
3044 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3045 start1 = current_kboard->Voverriding_terminal_local_map;
3046 else if (!NILP (Voverriding_local_map))
3047 start1 = Voverriding_local_map;
3048
3049 if (!NILP (start1))
3050 {
3051 describe_map_tree (start1, 1, shadow, prefix,
3052 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3053 shadow = Fcons (start1, shadow);
3054 }
3055 else
3056 {
3057 /* Print the minor mode and major mode keymaps. */
3058 int i, nmaps;
3059 Lisp_Object *modes, *maps;
3060
3061 /* Temporarily switch to `buffer', so that we can get that buffer's
3062 minor modes correctly. */
3063 Fset_buffer (buffer);
3064
3065 nmaps = current_minor_maps (&modes, &maps);
3066 Fset_buffer (outbuf);
3067
3068 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3069 XBUFFER (buffer), Qkeymap);
3070 if (!NILP (start1))
3071 {
3072 describe_map_tree (start1, 1, shadow, prefix,
3073 "\f\n`keymap' Property Bindings", nomenu,
3074 0, 0, 0);
3075 shadow = Fcons (start1, shadow);
3076 }
3077
3078 /* Print the minor mode maps. */
3079 for (i = 0; i < nmaps; i++)
3080 {
3081 /* The title for a minor mode keymap
3082 is constructed at run time.
3083 We let describe_map_tree do the actual insertion
3084 because it takes care of other features when doing so. */
3085 char *title, *p;
3086
3087 if (!SYMBOLP (modes[i]))
3088 abort();
3089
3090 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3091 *p++ = '\f';
3092 *p++ = '\n';
3093 *p++ = '`';
3094 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3095 SCHARS (SYMBOL_NAME (modes[i])));
3096 p += SCHARS (SYMBOL_NAME (modes[i]));
3097 *p++ = '\'';
3098 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3099 p += sizeof (" Minor Mode Bindings") - 1;
3100 *p = 0;
3101
3102 describe_map_tree (maps[i], 1, shadow, prefix,
3103 title, nomenu, 0, 0, 0);
3104 shadow = Fcons (maps[i], shadow);
3105 }
3106
3107 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3108 XBUFFER (buffer), Qlocal_map);
3109 if (!NILP (start1))
3110 {
3111 if (EQ (start1, XBUFFER (buffer)->keymap))
3112 describe_map_tree (start1, 1, shadow, prefix,
3113 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3114 else
3115 describe_map_tree (start1, 1, shadow, prefix,
3116 "\f\n`local-map' Property Bindings",
3117 nomenu, 0, 0, 0);
3118
3119 shadow = Fcons (start1, shadow);
3120 }
3121 }
3122
3123 describe_map_tree (current_global_map, 1, shadow, prefix,
3124 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3125
3126 /* Print the function-key-map translations under this prefix. */
3127 if (!NILP (Vfunction_key_map))
3128 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
3129 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3130
3131 UNGCPRO;
3132 return Qnil;
3133 }
3134
3135 /* Insert a description of the key bindings in STARTMAP,
3136 followed by those of all maps reachable through STARTMAP.
3137 If PARTIAL is nonzero, omit certain "uninteresting" commands
3138 (such as `undefined').
3139 If SHADOW is non-nil, it is a list of maps;
3140 don't mention keys which would be shadowed by any of them.
3141 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3142 TITLE, if not 0, is a string to insert at the beginning.
3143 TITLE should not end with a colon or a newline; we supply that.
3144 If NOMENU is not 0, then omit menu-bar commands.
3145
3146 If TRANSL is nonzero, the definitions are actually key translations
3147 so print strings and vectors differently.
3148
3149 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3150 to look through.
3151
3152 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3153 don't omit it; instead, mention it but say it is shadowed. */
3154
3155 void
3156 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3157 always_title, mention_shadow)
3158 Lisp_Object startmap, shadow, prefix;
3159 int partial;
3160 char *title;
3161 int nomenu;
3162 int transl;
3163 int always_title;
3164 int mention_shadow;
3165 {
3166 Lisp_Object maps, orig_maps, seen, sub_shadows;
3167 struct gcpro gcpro1, gcpro2, gcpro3;
3168 int something = 0;
3169 char *key_heading
3170 = "\
3171 key binding\n\
3172 --- -------\n";
3173
3174 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3175 seen = Qnil;
3176 sub_shadows = Qnil;
3177 GCPRO3 (maps, seen, sub_shadows);
3178
3179 if (nomenu)
3180 {
3181 Lisp_Object list;
3182
3183 /* Delete from MAPS each element that is for the menu bar. */
3184 for (list = maps; !NILP (list); list = XCDR (list))
3185 {
3186 Lisp_Object elt, prefix, tem;
3187
3188 elt = Fcar (list);
3189 prefix = Fcar (elt);
3190 if (XVECTOR (prefix)->size >= 1)
3191 {
3192 tem = Faref (prefix, make_number (0));
3193 if (EQ (tem, Qmenu_bar))
3194 maps = Fdelq (elt, maps);
3195 }
3196 }
3197 }
3198
3199 if (!NILP (maps) || always_title)
3200 {
3201 if (title)
3202 {
3203 insert_string (title);
3204 if (!NILP (prefix))
3205 {
3206 insert_string (" Starting With ");
3207 insert1 (Fkey_description (prefix, Qnil));
3208 }
3209 insert_string (":\n");
3210 }
3211 insert_string (key_heading);
3212 something = 1;
3213 }
3214
3215 for (; !NILP (maps); maps = Fcdr (maps))
3216 {
3217 register Lisp_Object elt, prefix, tail;
3218
3219 elt = Fcar (maps);
3220 prefix = Fcar (elt);
3221
3222 sub_shadows = Qnil;
3223
3224 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3225 {
3226 Lisp_Object shmap;
3227
3228 shmap = XCAR (tail);
3229
3230 /* If the sequence by which we reach this keymap is zero-length,
3231 then the shadow map for this keymap is just SHADOW. */
3232 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3233 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3234 ;
3235 /* If the sequence by which we reach this keymap actually has
3236 some elements, then the sequence's definition in SHADOW is
3237 what we should use. */
3238 else
3239 {
3240 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3241 if (INTEGERP (shmap))
3242 shmap = Qnil;
3243 }
3244
3245 /* If shmap is not nil and not a keymap,
3246 it completely shadows this map, so don't
3247 describe this map at all. */
3248 if (!NILP (shmap) && !KEYMAPP (shmap))
3249 goto skip;
3250
3251 if (!NILP (shmap))
3252 sub_shadows = Fcons (shmap, sub_shadows);
3253 }
3254
3255 /* Maps we have already listed in this loop shadow this map. */
3256 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3257 {
3258 Lisp_Object tem;
3259 tem = Fequal (Fcar (XCAR (tail)), prefix);
3260 if (!NILP (tem))
3261 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3262 }
3263
3264 describe_map (Fcdr (elt), prefix,
3265 transl ? describe_translation : describe_command,
3266 partial, sub_shadows, &seen, nomenu, mention_shadow);
3267
3268 skip: ;
3269 }
3270
3271 if (something)
3272 insert_string ("\n");
3273
3274 UNGCPRO;
3275 }
3276
3277 static int previous_description_column;
3278
3279 static void
3280 describe_command (definition, args)
3281 Lisp_Object definition, args;
3282 {
3283 register Lisp_Object tem1;
3284 int column = (int) current_column (); /* iftc */
3285 int description_column;
3286
3287 /* If column 16 is no good, go to col 32;
3288 but don't push beyond that--go to next line instead. */
3289 if (column > 30)
3290 {
3291 insert_char ('\n');
3292 description_column = 32;
3293 }
3294 else if (column > 14 || (column > 10 && previous_description_column == 32))
3295 description_column = 32;
3296 else
3297 description_column = 16;
3298
3299 Findent_to (make_number (description_column), make_number (1));
3300 previous_description_column = description_column;
3301
3302 if (SYMBOLP (definition))
3303 {
3304 tem1 = SYMBOL_NAME (definition);
3305 insert1 (tem1);
3306 insert_string ("\n");
3307 }
3308 else if (STRINGP (definition) || VECTORP (definition))
3309 insert_string ("Keyboard Macro\n");
3310 else if (KEYMAPP (definition))
3311 insert_string ("Prefix Command\n");
3312 else
3313 insert_string ("??\n");
3314 }
3315
3316 static void
3317 describe_translation (definition, args)
3318 Lisp_Object definition, args;
3319 {
3320 register Lisp_Object tem1;
3321
3322 Findent_to (make_number (16), make_number (1));
3323
3324 if (SYMBOLP (definition))
3325 {
3326 tem1 = SYMBOL_NAME (definition);
3327 insert1 (tem1);
3328 insert_string ("\n");
3329 }
3330 else if (STRINGP (definition) || VECTORP (definition))
3331 {
3332 insert1 (Fkey_description (definition, Qnil));
3333 insert_string ("\n");
3334 }
3335 else if (KEYMAPP (definition))
3336 insert_string ("Prefix Command\n");
3337 else
3338 insert_string ("??\n");
3339 }
3340
3341 /* describe_map puts all the usable elements of a sparse keymap
3342 into an array of `struct describe_map_elt',
3343 then sorts them by the events. */
3344
3345 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3346
3347 /* qsort comparison function for sorting `struct describe_map_elt' by
3348 the event field. */
3349
3350 static int
3351 describe_map_compare (aa, bb)
3352 const void *aa, *bb;
3353 {
3354 const struct describe_map_elt *a = aa, *b = bb;
3355 if (INTEGERP (a->event) && INTEGERP (b->event))
3356 return ((XINT (a->event) > XINT (b->event))
3357 - (XINT (a->event) < XINT (b->event)));
3358 if (!INTEGERP (a->event) && INTEGERP (b->event))
3359 return 1;
3360 if (INTEGERP (a->event) && !INTEGERP (b->event))
3361 return -1;
3362 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3363 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3364 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3365 : 0);
3366 return 0;
3367 }
3368
3369 /* Describe the contents of map MAP, assuming that this map itself is
3370 reached by the sequence of prefix keys PREFIX (a string or vector).
3371 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3372
3373 static void
3374 describe_map (map, prefix, elt_describer, partial, shadow,
3375 seen, nomenu, mention_shadow)
3376 register Lisp_Object map;
3377 Lisp_Object prefix;
3378 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3379 int partial;
3380 Lisp_Object shadow;
3381 Lisp_Object *seen;
3382 int nomenu;
3383 int mention_shadow;
3384 {
3385 Lisp_Object tail, definition, event;
3386 Lisp_Object tem;
3387 Lisp_Object suppress;
3388 Lisp_Object kludge;
3389 int first = 1;
3390 struct gcpro gcpro1, gcpro2, gcpro3;
3391
3392 /* These accumulate the values from sparse keymap bindings,
3393 so we can sort them and handle them in order. */
3394 int length_needed = 0;
3395 struct describe_map_elt *vect;
3396 int slots_used = 0;
3397 int i;
3398
3399 suppress = Qnil;
3400
3401 if (partial)
3402 suppress = intern ("suppress-keymap");
3403
3404 /* This vector gets used to present single keys to Flookup_key. Since
3405 that is done once per keymap element, we don't want to cons up a
3406 fresh vector every time. */
3407 kludge = Fmake_vector (make_number (1), Qnil);
3408 definition = Qnil;
3409
3410 for (tail = map; CONSP (tail); tail = XCDR (tail))
3411 length_needed++;
3412
3413 vect = ((struct describe_map_elt *)
3414 alloca (sizeof (struct describe_map_elt) * length_needed));
3415
3416 GCPRO3 (prefix, definition, kludge);
3417
3418 for (tail = map; CONSP (tail); tail = XCDR (tail))
3419 {
3420 QUIT;
3421
3422 if (VECTORP (XCAR (tail))
3423 || CHAR_TABLE_P (XCAR (tail)))
3424 describe_vector (XCAR (tail),
3425 prefix, Qnil, elt_describer, partial, shadow, map,
3426 (int *)0, 0, 1, mention_shadow);
3427 else if (CONSP (XCAR (tail)))
3428 {
3429 int this_shadowed = 0;
3430
3431 event = XCAR (XCAR (tail));
3432
3433 /* Ignore bindings whose "prefix" are not really valid events.
3434 (We get these in the frames and buffers menu.) */
3435 if (!(SYMBOLP (event) || INTEGERP (event)))
3436 continue;
3437
3438 if (nomenu && EQ (event, Qmenu_bar))
3439 continue;
3440
3441 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3442
3443 /* Don't show undefined commands or suppressed commands. */
3444 if (NILP (definition)) continue;
3445 if (SYMBOLP (definition) && partial)
3446 {
3447 tem = Fget (definition, suppress);
3448 if (!NILP (tem))
3449 continue;
3450 }
3451
3452 /* Don't show a command that isn't really visible
3453 because a local definition of the same key shadows it. */
3454
3455 ASET (kludge, 0, event);
3456 if (!NILP (shadow))
3457 {
3458 tem = shadow_lookup (shadow, kludge, Qt);
3459 if (!NILP (tem))
3460 {
3461 /* If both bindings are keymaps, this key is a prefix key,
3462 so don't say it is shadowed. */
3463 if (KEYMAPP (definition) && KEYMAPP (tem))
3464 ;
3465 /* Avoid generating duplicate entries if the
3466 shadowed binding has the same definition. */
3467 else if (mention_shadow && !EQ (tem, definition))
3468 this_shadowed = 1;
3469 else
3470 continue;
3471 }
3472 }
3473
3474 tem = Flookup_key (map, kludge, Qt);
3475 if (!EQ (tem, definition)) continue;
3476
3477 vect[slots_used].event = event;
3478 vect[slots_used].definition = definition;
3479 vect[slots_used].shadowed = this_shadowed;
3480 slots_used++;
3481 }
3482 else if (EQ (XCAR (tail), Qkeymap))
3483 {
3484 /* The same keymap might be in the structure twice, if we're
3485 using an inherited keymap. So skip anything we've already
3486 encountered. */
3487 tem = Fassq (tail, *seen);
3488 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3489 break;
3490 *seen = Fcons (Fcons (tail, prefix), *seen);
3491 }
3492 }
3493
3494 /* If we found some sparse map events, sort them. */
3495
3496 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3497 describe_map_compare);
3498
3499 /* Now output them in sorted order. */
3500
3501 for (i = 0; i < slots_used; i++)
3502 {
3503 Lisp_Object start, end;
3504
3505 if (first)
3506 {
3507 previous_description_column = 0;
3508 insert ("\n", 1);
3509 first = 0;
3510 }
3511
3512 ASET (kludge, 0, vect[i].event);
3513 start = vect[i].event;
3514 end = start;
3515
3516 definition = vect[i].definition;
3517
3518 /* Find consecutive chars that are identically defined. */
3519 if (INTEGERP (vect[i].event))
3520 {
3521 while (i + 1 < slots_used
3522 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3523 && !NILP (Fequal (vect[i + 1].definition, definition))
3524 && vect[i].shadowed == vect[i + 1].shadowed)
3525 i++;
3526 end = vect[i].event;
3527 }
3528
3529 /* Now START .. END is the range to describe next. */
3530
3531 /* Insert the string to describe the event START. */
3532 insert1 (Fkey_description (kludge, prefix));
3533
3534 if (!EQ (start, end))
3535 {
3536 insert (" .. ", 4);
3537
3538 ASET (kludge, 0, end);
3539 /* Insert the string to describe the character END. */
3540 insert1 (Fkey_description (kludge, prefix));
3541 }
3542
3543 /* Print a description of the definition of this character.
3544 elt_describer will take care of spacing out far enough
3545 for alignment purposes. */
3546 (*elt_describer) (vect[i].definition, Qnil);
3547
3548 if (vect[i].shadowed)
3549 {
3550 SET_PT (PT - 1);
3551 insert_string ("\n (that binding is currently shadowed by another mode)");
3552 SET_PT (PT + 1);
3553 }
3554 }
3555
3556 UNGCPRO;
3557 }
3558
3559 static void
3560 describe_vector_princ (elt, fun)
3561 Lisp_Object elt, fun;
3562 {
3563 Findent_to (make_number (16), make_number (1));
3564 call1 (fun, elt);
3565 Fterpri (Qnil);
3566 }
3567
3568 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3569 doc: /* Insert a description of contents of VECTOR.
3570 This is text showing the elements of vector matched against indices.
3571 DESCRIBER is the output function used; nil means use `princ'. */)
3572 (vector, describer)
3573 Lisp_Object vector, describer;
3574 {
3575 int count = SPECPDL_INDEX ();
3576 if (NILP (describer))
3577 describer = intern ("princ");
3578 specbind (Qstandard_output, Fcurrent_buffer ());
3579 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3580 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3581 Qnil, Qnil, (int *)0, 0, 0, 0);
3582
3583 return unbind_to (count, Qnil);
3584 }
3585
3586 /* Insert in the current buffer a description of the contents of VECTOR.
3587 We call ELT_DESCRIBER to insert the description of one value found
3588 in VECTOR.
3589
3590 ELT_PREFIX describes what "comes before" the keys or indices defined
3591 by this vector. This is a human-readable string whose size
3592 is not necessarily related to the situation.
3593
3594 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3595 leads to this keymap.
3596
3597 If the vector is a chartable, ELT_PREFIX is the vector
3598 of bytes that lead to the character set or portion of a character
3599 set described by this chartable.
3600
3601 If PARTIAL is nonzero, it means do not mention suppressed commands
3602 (that assumes the vector is in a keymap).
3603
3604 SHADOW is a list of keymaps that shadow this map.
3605 If it is non-nil, then we look up the key in those maps
3606 and we don't mention it now if it is defined by any of them.
3607
3608 ENTIRE_MAP is the keymap in which this vector appears.
3609 If the definition in effect in the whole map does not match
3610 the one in this vector, we ignore this one.
3611
3612 When describing a sub-char-table, INDICES is a list of
3613 indices at higher levels in this char-table,
3614 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3615
3616 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3617
3618 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3619
3620 static void
3621 describe_vector (vector, prefix, args, elt_describer,
3622 partial, shadow, entire_map,
3623 indices, char_table_depth, keymap_p,
3624 mention_shadow)
3625 register Lisp_Object vector;
3626 Lisp_Object prefix, args;
3627 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3628 int partial;
3629 Lisp_Object shadow;
3630 Lisp_Object entire_map;
3631 int *indices;
3632 int char_table_depth;
3633 int keymap_p;
3634 int mention_shadow;
3635 {
3636 Lisp_Object definition;
3637 Lisp_Object tem2;
3638 Lisp_Object elt_prefix = Qnil;
3639 register int i;
3640 Lisp_Object suppress;
3641 Lisp_Object kludge;
3642 int first = 1;
3643 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3644 /* Range of elements to be handled. */
3645 int from, to;
3646 /* A flag to tell if a leaf in this level of char-table is not a
3647 generic character (i.e. a complete multibyte character). */
3648 int complete_char;
3649 int character;
3650 int starting_i;
3651
3652 suppress = Qnil;
3653
3654 if (indices == 0)
3655 indices = (int *) alloca (3 * sizeof (int));
3656
3657 definition = Qnil;
3658
3659 if (!keymap_p)
3660 {
3661 /* Call Fkey_description first, to avoid GC bug for the other string. */
3662 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3663 {
3664 Lisp_Object tem;
3665 tem = Fkey_description (prefix, Qnil);
3666 elt_prefix = concat2 (tem, build_string (" "));
3667 }
3668 prefix = Qnil;
3669 }
3670
3671 /* This vector gets used to present single keys to Flookup_key. Since
3672 that is done once per vector element, we don't want to cons up a
3673 fresh vector every time. */
3674 kludge = Fmake_vector (make_number (1), Qnil);
3675 GCPRO4 (elt_prefix, prefix, definition, kludge);
3676
3677 if (partial)
3678 suppress = intern ("suppress-keymap");
3679
3680 if (CHAR_TABLE_P (vector))
3681 {
3682 if (char_table_depth == 0)
3683 {
3684 /* VECTOR is a top level char-table. */
3685 complete_char = 1;
3686 from = 0;
3687 to = CHAR_TABLE_ORDINARY_SLOTS;
3688 }
3689 else
3690 {
3691 /* VECTOR is a sub char-table. */
3692 if (char_table_depth >= 3)
3693 /* A char-table is never that deep. */
3694 error ("Too deep char table");
3695
3696 complete_char
3697 = (CHARSET_VALID_P (indices[0])
3698 && ((CHARSET_DIMENSION (indices[0]) == 1
3699 && char_table_depth == 1)
3700 || char_table_depth == 2));
3701
3702 /* Meaningful elements are from 32th to 127th. */
3703 from = 32;
3704 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3705 }
3706 }
3707 else
3708 {
3709 /* This does the right thing for ordinary vectors. */
3710
3711 complete_char = 1;
3712 from = 0;
3713 to = XVECTOR (vector)->size;
3714 }
3715
3716 for (i = from; i < to; i++)
3717 {
3718 int this_shadowed = 0;
3719 QUIT;
3720
3721 if (CHAR_TABLE_P (vector))
3722 {
3723 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3724 complete_char = 0;
3725
3726 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3727 && !CHARSET_DEFINED_P (i - 128))
3728 continue;
3729
3730 definition
3731 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3732 }
3733 else
3734 definition = get_keyelt (AREF (vector, i), 0);
3735
3736 if (NILP (definition)) continue;
3737
3738 /* Don't mention suppressed commands. */
3739 if (SYMBOLP (definition) && partial)
3740 {
3741 Lisp_Object tem;
3742
3743 tem = Fget (definition, suppress);
3744
3745 if (!NILP (tem)) continue;
3746 }
3747
3748 /* Set CHARACTER to the character this entry describes, if any.
3749 Also update *INDICES. */
3750 if (CHAR_TABLE_P (vector))
3751 {
3752 indices[char_table_depth] = i;
3753
3754 if (char_table_depth == 0)
3755 {
3756 character = i;
3757 indices[0] = i - 128;
3758 }
3759 else if (complete_char)
3760 {
3761 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3762 }
3763 else
3764 character = 0;
3765 }
3766 else
3767 character = i;
3768
3769 ASET (kludge, 0, make_number (character));
3770
3771 /* If this binding is shadowed by some other map, ignore it. */
3772 if (!NILP (shadow) && complete_char)
3773 {
3774 Lisp_Object tem;
3775
3776 tem = shadow_lookup (shadow, kludge, Qt);
3777
3778 if (!NILP (tem))
3779 {
3780 if (mention_shadow)
3781 this_shadowed = 1;
3782 else
3783 continue;
3784 }
3785 }
3786
3787 /* Ignore this definition if it is shadowed by an earlier
3788 one in the same keymap. */
3789 if (!NILP (entire_map) && complete_char)
3790 {
3791 Lisp_Object tem;
3792
3793 tem = Flookup_key (entire_map, kludge, Qt);
3794
3795 if (!EQ (tem, definition))
3796 continue;
3797 }
3798
3799 if (first)
3800 {
3801 if (char_table_depth == 0)
3802 insert ("\n", 1);
3803 first = 0;
3804 }
3805
3806 /* For a sub char-table, show the depth by indentation.
3807 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3808 if (char_table_depth > 0)
3809 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3810
3811 /* Output the prefix that applies to every entry in this map. */
3812 if (!NILP (elt_prefix))
3813 insert1 (elt_prefix);
3814
3815 /* Insert or describe the character this slot is for,
3816 or a description of what it is for. */
3817 if (SUB_CHAR_TABLE_P (vector))
3818 {
3819 if (complete_char)
3820 insert_char (character);
3821 else
3822 {
3823 /* We need an octal representation for this block of
3824 characters. */
3825 char work[16];
3826 sprintf (work, "(row %d)", i);
3827 insert (work, strlen (work));
3828 }
3829 }
3830 else if (CHAR_TABLE_P (vector))
3831 {
3832 if (complete_char)
3833 insert1 (Fkey_description (kludge, prefix));
3834 else
3835 {
3836 /* Print the information for this character set. */
3837 insert_string ("<");
3838 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3839 if (STRINGP (tem2))
3840 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3841 SBYTES (tem2), 0);
3842 else
3843 insert ("?", 1);
3844 insert (">", 1);
3845 }
3846 }
3847 else
3848 {
3849 insert1 (Fkey_description (kludge, prefix));
3850 }
3851
3852 /* If we find a sub char-table within a char-table,
3853 scan it recursively; it defines the details for
3854 a character set or a portion of a character set. */
3855 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3856 {
3857 insert ("\n", 1);
3858 describe_vector (definition, prefix, args, elt_describer,
3859 partial, shadow, entire_map,
3860 indices, char_table_depth + 1, keymap_p,
3861 mention_shadow);
3862 continue;
3863 }
3864
3865 starting_i = i;
3866
3867 /* Find all consecutive characters or rows that have the same
3868 definition. But, for elements of a top level char table, if
3869 they are for charsets, we had better describe one by one even
3870 if they have the same definition. */
3871 if (CHAR_TABLE_P (vector))
3872 {
3873 int limit = to;
3874
3875 if (char_table_depth == 0)
3876 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3877
3878 while (i + 1 < limit
3879 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3880 !NILP (tem2))
3881 && !NILP (Fequal (tem2, definition)))
3882 i++;
3883 }
3884 else
3885 while (i + 1 < to
3886 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3887 !NILP (tem2))
3888 && !NILP (Fequal (tem2, definition)))
3889 i++;
3890
3891
3892 /* If we have a range of more than one character,
3893 print where the range reaches to. */
3894
3895 if (i != starting_i)
3896 {
3897 insert (" .. ", 4);
3898
3899 ASET (kludge, 0, make_number (i));
3900
3901 if (!NILP (elt_prefix))
3902 insert1 (elt_prefix);
3903
3904 if (CHAR_TABLE_P (vector))
3905 {
3906 if (char_table_depth == 0)
3907 {
3908 insert1 (Fkey_description (kludge, prefix));
3909 }
3910 else if (complete_char)
3911 {
3912 indices[char_table_depth] = i;
3913 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3914 insert_char (character);
3915 }
3916 else
3917 {
3918 /* We need an octal representation for this block of
3919 characters. */
3920 char work[16];
3921 sprintf (work, "(row %d)", i);
3922 insert (work, strlen (work));
3923 }
3924 }
3925 else
3926 {
3927 insert1 (Fkey_description (kludge, prefix));
3928 }
3929 }
3930
3931 /* Print a description of the definition of this character.
3932 elt_describer will take care of spacing out far enough
3933 for alignment purposes. */
3934 (*elt_describer) (definition, args);
3935
3936 if (this_shadowed)
3937 {
3938 SET_PT (PT - 1);
3939 insert_string (" (binding currently shadowed)");
3940 SET_PT (PT + 1);
3941 }
3942 }
3943
3944 /* For (sub) char-table, print `defalt' slot at last. */
3945 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3946 {
3947 insert (" ", char_table_depth * 2);
3948 insert_string ("<<default>>");
3949 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3950 }
3951
3952 UNGCPRO;
3953 }
3954 \f
3955 /* Apropos - finding all symbols whose names match a regexp. */
3956 static Lisp_Object apropos_predicate;
3957 static Lisp_Object apropos_accumulate;
3958
3959 static void
3960 apropos_accum (symbol, string)
3961 Lisp_Object symbol, string;
3962 {
3963 register Lisp_Object tem;
3964
3965 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3966 if (!NILP (tem) && !NILP (apropos_predicate))
3967 tem = call1 (apropos_predicate, symbol);
3968 if (!NILP (tem))
3969 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3970 }
3971
3972 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3973 doc: /* Show all symbols whose names contain match for REGEXP.
3974 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3975 for each symbol and a symbol is mentioned only if that returns non-nil.
3976 Return list of symbols found. */)
3977 (regexp, predicate)
3978 Lisp_Object regexp, predicate;
3979 {
3980 Lisp_Object tem;
3981 CHECK_STRING (regexp);
3982 apropos_predicate = predicate;
3983 apropos_accumulate = Qnil;
3984 map_obarray (Vobarray, apropos_accum, regexp);
3985 tem = Fsort (apropos_accumulate, Qstring_lessp);
3986 apropos_accumulate = Qnil;
3987 apropos_predicate = Qnil;
3988 return tem;
3989 }
3990 \f
3991 void
3992 syms_of_keymap ()
3993 {
3994 Qkeymap = intern ("keymap");
3995 staticpro (&Qkeymap);
3996 staticpro (&apropos_predicate);
3997 staticpro (&apropos_accumulate);
3998 apropos_predicate = Qnil;
3999 apropos_accumulate = Qnil;
4000
4001 /* Now we are ready to set up this property, so we can
4002 create char tables. */
4003 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
4004
4005 /* Initialize the keymaps standardly used.
4006 Each one is the value of a Lisp variable, and is also
4007 pointed to by a C variable */
4008
4009 global_map = Fmake_keymap (Qnil);
4010 Fset (intern ("global-map"), global_map);
4011
4012 current_global_map = global_map;
4013 staticpro (&global_map);
4014 staticpro (&current_global_map);
4015
4016 meta_map = Fmake_keymap (Qnil);
4017 Fset (intern ("esc-map"), meta_map);
4018 Ffset (intern ("ESC-prefix"), meta_map);
4019
4020 control_x_map = Fmake_keymap (Qnil);
4021 Fset (intern ("ctl-x-map"), control_x_map);
4022 Ffset (intern ("Control-X-prefix"), control_x_map);
4023
4024 exclude_keys
4025 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4026 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4027 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4028 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4029 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4030 Qnil)))));
4031 staticpro (&exclude_keys);
4032
4033 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4034 doc: /* List of commands given new key bindings recently.
4035 This is used for internal purposes during Emacs startup;
4036 don't alter it yourself. */);
4037 Vdefine_key_rebound_commands = Qt;
4038
4039 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4040 doc: /* Default keymap to use when reading from the minibuffer. */);
4041 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4042
4043 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4044 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
4045 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4046 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4047
4048 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4049 doc: /* Local keymap for minibuffer input with completion. */);
4050 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4051 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4052
4053 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4054 &Vminibuffer_local_filename_completion_map,
4055 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4056 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4057 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4058 Vminibuffer_local_completion_map);
4059
4060
4061 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4062 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4063 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4064 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4065 Vminibuffer_local_completion_map);
4066
4067 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4068 &Vminibuffer_local_must_match_filename_map,
4069 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4070 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4071 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4072 Vminibuffer_local_must_match_map);
4073
4074 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4075 doc: /* Alist of keymaps to use for minor modes.
4076 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4077 key sequences and look up bindings iff VARIABLE's value is non-nil.
4078 If two active keymaps bind the same key, the keymap appearing earlier
4079 in the list takes precedence. */);
4080 Vminor_mode_map_alist = Qnil;
4081
4082 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4083 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4084 This variable is an alist just like `minor-mode-map-alist', and it is
4085 used the same way (and before `minor-mode-map-alist'); however,
4086 it is provided for major modes to bind locally. */);
4087 Vminor_mode_overriding_map_alist = Qnil;
4088
4089 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4090 doc: /* List of keymap alists to use for emulations modes.
4091 It is intended for modes or packages using multiple minor-mode keymaps.
4092 Each element is a keymap alist just like `minor-mode-map-alist', or a
4093 symbol with a variable binding which is a keymap alist, and it is used
4094 the same way. The "active" keymaps in each alist are used before
4095 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4096 Vemulation_mode_map_alists = Qnil;
4097
4098
4099 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
4100 doc: /* Keymap that translates key sequences to key sequences during input.
4101 This is used mainly for mapping ASCII function key sequences into
4102 real Emacs function key events (symbols).
4103
4104 The `read-key-sequence' function replaces any subsequence bound by
4105 `function-key-map' with its binding. More precisely, when the active
4106 keymaps have no binding for the current key sequence but
4107 `function-key-map' binds a suffix of the sequence to a vector or string,
4108 `read-key-sequence' replaces the matching suffix with its binding, and
4109 continues with the new sequence.
4110
4111 If the binding is a function, it is called with one argument (the prompt)
4112 and its return value (a key sequence) is used.
4113
4114 The events that come from bindings in `function-key-map' are not
4115 themselves looked up in `function-key-map'.
4116
4117 For example, suppose `function-key-map' binds `ESC O P' to [f1].
4118 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
4119 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
4120 key, typing `ESC O P x' would return [f1 x]. */);
4121 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
4122
4123 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
4124 doc: /* Keymap of key translations that can override keymaps.
4125 This keymap works like `function-key-map', but comes after that,
4126 and its non-prefix bindings override ordinary bindings. */);
4127 Vkey_translation_map = Qnil;
4128
4129 staticpro (&Vmouse_events);
4130 Vmouse_events = Fcons (intern ("menu-bar"),
4131 Fcons (intern ("tool-bar"),
4132 Fcons (intern ("header-line"),
4133 Fcons (intern ("mode-line"),
4134 Fcons (intern ("mouse-1"),
4135 Fcons (intern ("mouse-2"),
4136 Fcons (intern ("mouse-3"),
4137 Fcons (intern ("mouse-4"),
4138 Fcons (intern ("mouse-5"),
4139 Qnil)))))))));
4140
4141
4142 Qsingle_key_description = intern ("single-key-description");
4143 staticpro (&Qsingle_key_description);
4144
4145 Qkey_description = intern ("key-description");
4146 staticpro (&Qkey_description);
4147
4148 Qkeymapp = intern ("keymapp");
4149 staticpro (&Qkeymapp);
4150
4151 Qnon_ascii = intern ("non-ascii");
4152 staticpro (&Qnon_ascii);
4153
4154 Qmenu_item = intern ("menu-item");
4155 staticpro (&Qmenu_item);
4156
4157 Qremap = intern ("remap");
4158 staticpro (&Qremap);
4159
4160 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4161 staticpro (&command_remapping_vector);
4162
4163 where_is_cache_keymaps = Qt;
4164 where_is_cache = Qnil;
4165 staticpro (&where_is_cache);
4166 staticpro (&where_is_cache_keymaps);
4167
4168 defsubr (&Skeymapp);
4169 defsubr (&Skeymap_parent);
4170 defsubr (&Skeymap_prompt);
4171 defsubr (&Sset_keymap_parent);
4172 defsubr (&Smake_keymap);
4173 defsubr (&Smake_sparse_keymap);
4174 defsubr (&Smap_keymap);
4175 defsubr (&Scopy_keymap);
4176 defsubr (&Scommand_remapping);
4177 defsubr (&Skey_binding);
4178 defsubr (&Slocal_key_binding);
4179 defsubr (&Sglobal_key_binding);
4180 defsubr (&Sminor_mode_key_binding);
4181 defsubr (&Sdefine_key);
4182 defsubr (&Slookup_key);
4183 defsubr (&Sdefine_prefix_command);
4184 defsubr (&Suse_global_map);
4185 defsubr (&Suse_local_map);
4186 defsubr (&Scurrent_local_map);
4187 defsubr (&Scurrent_global_map);
4188 defsubr (&Scurrent_minor_mode_maps);
4189 defsubr (&Scurrent_active_maps);
4190 defsubr (&Saccessible_keymaps);
4191 defsubr (&Skey_description);
4192 defsubr (&Sdescribe_vector);
4193 defsubr (&Ssingle_key_description);
4194 defsubr (&Stext_char_description);
4195 defsubr (&Swhere_is_internal);
4196 defsubr (&Sdescribe_buffer_bindings);
4197 defsubr (&Sapropos_internal);
4198 }
4199
4200 void
4201 keys_of_keymap ()
4202 {
4203 initial_define_key (global_map, 033, "ESC-prefix");
4204 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4205 }
4206
4207 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4208 (do not change this comment) */