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