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