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