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