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