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