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