aboutsummaryrefslogtreecommitdiffstats
path: root/src/keymap.c
diff options
context:
space:
mode:
authorStefan Monnier2011-07-02 00:27:41 -0400
committerStefan Monnier2011-07-02 00:27:41 -0400
commit3349e122e2ed4e1e96851bdf84ce8ae4732b6420 (patch)
treeac1309f41e4c5dc26ddd8c7f313ece238fa65809 /src/keymap.c
parent3de63bf809c2a36a5eae8e7383b2590c5ab1bcf7 (diff)
downloademacs-3349e122e2ed4e1e96851bdf84ce8ae4732b6420.tar.gz
emacs-3349e122e2ed4e1e96851bdf84ce8ae4732b6420.zip
Add multiple inheritance to keymaps.
* src/keymap.c (Fmake_composed_keymap): New function. (Fset_keymap_parent): Simplify. (fix_submap_inheritance): Remove. (access_keymap_1): New function extracted from access_keymap to handle embedded parents and handle lists of maps. (access_keymap): Use it. (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap) (Fcopy_keymap): Handle embedded parents. (Fcommand_remapping, define_as_prefix): Simplify. (Fkey_binding): Simplify. (syms_of_keymap): Move minibuffer-local-completion-map, minibuffer-local-filename-completion-map, minibuffer-local-must-match-map, and minibuffer-local-filename-must-match-map to Elisp. (syms_of_keymap): Defsubr make-composed-keymap. * src/keyboard.c (menu_bar_items): Use map_keymap_canonical. (parse_menu_item): Trivial simplification. * lisp/subr.el (remq): Don't allocate if it's not needed. (keymap--menu-item-binding, keymap--menu-item-with-binding) (keymap--merge-bindings): New functions. (keymap-canonicalize): Use them to refine the canonicalization. * lisp/minibuffer.el (minibuffer-local-completion-map) (minibuffer-local-must-match-map): Move initialization from C. (minibuffer-local-filename-completion-map): Move initialization from C; don't inherit from anything here. (minibuffer-local-filename-must-match-map): Make obsolete. (completing-read-default): Use make-composed-keymap to combine minibuffer-local-filename-completion-map with either minibuffer-local-must-match-map or minibuffer-local-filename-completion-map.
Diffstat (limited to 'src/keymap.c')
-rw-r--r--src/keymap.c533
1 files changed, 183 insertions, 350 deletions
diff --git a/src/keymap.c b/src/keymap.c
index ac7f651e283..062fb5d0d5f 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -16,6 +16,27 @@ GNU General Public License for more details.
16You should have received a copy of the GNU General Public License 16You should have received a copy of the GNU General Public License
17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18 18
19/* Old BUGS:
20 - [M-C-a] != [?\M-\C-a]
21 - [M-f2] != [?\e f2].
22 - (define-key map [menu-bar foo] <bla>) does not always place <bla>
23 at the head of the menu (if `foo' was already bound earlier and
24 then unbound, for example).
25 TODO:
26 - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
27 - Think about the various defaulting that's currently hard-coded in
28 keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
29 and make it more generic. Maybe we should allow mappings of the
30 form (PREDICATE . BINDING) as generalization of the default binding,
31 tho probably a cleaner way to attack this is to allow functional
32 keymaps (i.e. keymaps that are implemented as functions that implement
33 a few different methods like `lookup', `map', ...).
34 - Make [a] equivalent to [?a].
35 BEWARE:
36 - map-keymap should work meaningfully even if entries are added/removed
37 to the keymap while iterating through it:
38 start - removed <= visited <= start + added
39 */
19 40
20#include <config.h> 41#include <config.h>
21#include <stdio.h> 42#include <stdio.h>
@@ -73,7 +94,6 @@ static Lisp_Object where_is_cache_keymaps;
73 94
74static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object); 95static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
75static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); 96static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
76static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object);
77 97
78static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); 98static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
79static void describe_command (Lisp_Object, Lisp_Object); 99static void describe_command (Lisp_Object, Lisp_Object);
@@ -130,6 +150,17 @@ in case you use it as a menu with `x-popup-menu'. */)
130 return Fcons (Qkeymap, Qnil); 150 return Fcons (Qkeymap, Qnil);
131} 151}
132 152
153DEFUN ("make-composed-keymap", Fmake_composed_keymap, Smake_composed_keymap,
154 0, MANY, 0,
155 doc: /* Construct and return a new keymap composed of KEYMAPS.
156When looking up a key in the returned map, the key is looked in each
157keymap in turn until a binding is found.
158usage: (make-composed-keymap &rest KEYMAPS) */)
159 (ptrdiff_t nargs, Lisp_Object *args)
160{
161 return Fcons (Qkeymap, Flist (nargs, args));
162}
163
133/* This function is used for installing the standard key bindings 164/* This function is used for installing the standard key bindings
134 at initialization time. 165 at initialization time.
135 166
@@ -174,6 +205,12 @@ when reading a key-sequence to be looked-up in this keymap. */)
174 Lisp_Object tem = XCAR (map); 205 Lisp_Object tem = XCAR (map);
175 if (STRINGP (tem)) 206 if (STRINGP (tem))
176 return tem; 207 return tem;
208 else if (KEYMAPP (tem))
209 {
210 tem = Fkeymap_prompt (tem);
211 if (!NILP (tem))
212 return tem;
213 }
177 map = XCDR (map); 214 map = XCDR (map);
178 } 215 }
179 return Qnil; 216 return Qnil;
@@ -300,23 +337,16 @@ Return PARENT. PARENT should be nil or another keymap. */)
300{ 337{
301 Lisp_Object list, prev; 338 Lisp_Object list, prev;
302 struct gcpro gcpro1, gcpro2; 339 struct gcpro gcpro1, gcpro2;
303 int i;
304 340
305 /* Force a keymap flush for the next call to where-is. 341 /* Flush any reverse-map cache. */
306 Since this can be called from within where-is, we don't set where_is_cache 342 where_is_cache = Qnil; where_is_cache_keymaps = Qt;
307 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
308 be changed during where-is, while where_is_cache_keymaps is only used at
309 the very beginning of where-is and can thus be changed here without any
310 adverse effect.
311 This is a very minor correctness (rather than safety) issue. */
312 where_is_cache_keymaps = Qt;
313 343
314 GCPRO2 (keymap, parent); 344 GCPRO2 (keymap, parent);
315 keymap = get_keymap (keymap, 1, 1); 345 keymap = get_keymap (keymap, 1, 1);
316 346
317 if (!NILP (parent)) 347 if (!NILP (parent))
318 { 348 {
319 parent = get_keymap (parent, 1, 1); 349 parent = get_keymap (parent, 1, 0);
320 350
321 /* Check for cycles. */ 351 /* Check for cycles. */
322 if (keymap_memberp (keymap, parent)) 352 if (keymap_memberp (keymap, parent))
@@ -332,121 +362,35 @@ Return PARENT. PARENT should be nil or another keymap. */)
332 If we came to the end, add the parent in PREV. */ 362 If we came to the end, add the parent in PREV. */
333 if (!CONSP (list) || KEYMAPP (list)) 363 if (!CONSP (list) || KEYMAPP (list))
334 { 364 {
335 /* If we already have the right parent, return now
336 so that we avoid the loops below. */
337 if (EQ (XCDR (prev), parent))
338 RETURN_UNGCPRO (parent);
339
340 CHECK_IMPURE (prev); 365 CHECK_IMPURE (prev);
341 XSETCDR (prev, parent); 366 XSETCDR (prev, parent);
342 break; 367 RETURN_UNGCPRO (parent);
343 } 368 }
344 prev = list; 369 prev = list;
345 } 370 }
346
347 /* Scan through for submaps, and set their parents too. */
348
349 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
350 {
351 /* Stop the scan when we come to the parent. */
352 if (EQ (XCAR (list), Qkeymap))
353 break;
354
355 /* If this element holds a prefix map, deal with it. */
356 if (CONSP (XCAR (list))
357 && CONSP (XCDR (XCAR (list))))
358 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
359 XCDR (XCAR (list)));
360
361 if (VECTORP (XCAR (list)))
362 for (i = 0; i < ASIZE (XCAR (list)); i++)
363 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
364 fix_submap_inheritance (keymap, make_number (i),
365 XVECTOR (XCAR (list))->contents[i]);
366
367 if (CHAR_TABLE_P (XCAR (list)))
368 {
369 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
370 }
371 }
372
373 RETURN_UNGCPRO (parent);
374}
375
376/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
377 if EVENT is also a prefix in MAP's parent,
378 make sure that SUBMAP inherits that definition as its own parent. */
379
380static void
381fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
382{
383 Lisp_Object map_parent, parent_entry;
384
385 /* SUBMAP is a cons that we found as a key binding.
386 Discard the other things found in a menu key binding. */
387
388 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
389
390 /* If it isn't a keymap now, there's no work to do. */
391 if (!CONSP (submap))
392 return;
393
394 map_parent = keymap_parent (map, 0);
395 if (!NILP (map_parent))
396 parent_entry =
397 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
398 else
399 parent_entry = Qnil;
400
401 /* If MAP's parent has something other than a keymap,
402 our own submap shadows it completely. */
403 if (!CONSP (parent_entry))
404 return;
405
406 if (! EQ (parent_entry, submap))
407 {
408 Lisp_Object submap_parent;
409 submap_parent = submap;
410 while (1)
411 {
412 Lisp_Object tem;
413
414 tem = keymap_parent (submap_parent, 0);
415
416 if (KEYMAPP (tem))
417 {
418 if (keymap_memberp (tem, parent_entry))
419 /* Fset_keymap_parent could create a cycle. */
420 return;
421 submap_parent = tem;
422 }
423 else
424 break;
425 }
426 Fset_keymap_parent (submap_parent, parent_entry);
427 }
428} 371}
429 372
373
430/* Look up IDX in MAP. IDX may be any sort of event. 374/* Look up IDX in MAP. IDX may be any sort of event.
431 Note that this does only one level of lookup; IDX must be a single 375 Note that this does only one level of lookup; IDX must be a single
432 event, not a sequence. 376 event, not a sequence.
433 377
378 MAP must be a keymap or a list of keymaps.
379
434 If T_OK is non-zero, bindings for Qt are treated as default 380 If T_OK is non-zero, bindings for Qt are treated as default
435 bindings; any key left unmentioned by other tables and bindings is 381 bindings; any key left unmentioned by other tables and bindings is
436 given the binding of Qt. 382 given the binding of Qt.
437 383
438 If T_OK is zero, bindings for Qt are not treated specially. 384 If T_OK is zero, bindings for Qt are not treated specially.
439 385
440 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */ 386 If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
387
388 Returns Qunbound if no binding was found (and returns Qnil if a nil
389 binding was found). */
441 390
442Lisp_Object 391Lisp_Object
443access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload) 392access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
444{ 393{
445 Lisp_Object val;
446
447 /* Qunbound in VAL means we have found no binding yet. */
448 val = Qunbound;
449
450 /* If idx is a list (some sort of mouse click, perhaps?), 394 /* If idx is a list (some sort of mouse click, perhaps?),
451 the index we want to use is the car of the list, which 395 the index we want to use is the car of the list, which
452 ought to be a symbol. */ 396 ought to be a symbol. */
@@ -461,21 +405,21 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
461 with more than 24 bits of integer. */ 405 with more than 24 bits of integer. */
462 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); 406 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
463 407
464 /* Handle the special meta -> esc mapping. */ 408 /* Handle the special meta -> esc mapping. */
465 if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier) 409 if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier)
466 { 410 {
467 /* See if there is a meta-map. If there's none, there is 411 /* See if there is a meta-map. If there's none, there is
468 no binding for IDX, unless a default binding exists in MAP. */ 412 no binding for IDX, unless a default binding exists in MAP. */
469 struct gcpro gcpro1; 413 struct gcpro gcpro1;
470 Lisp_Object event_meta_map; 414 Lisp_Object event_meta_binding, event_meta_map;
471 GCPRO1 (map); 415 GCPRO1 (map);
472 /* A strange value in which Meta is set would cause 416 /* A strange value in which Meta is set would cause
473 infinite recursion. Protect against that. */ 417 infinite recursion. Protect against that. */
474 if (XINT (meta_prefix_char) & CHAR_META) 418 if (XINT (meta_prefix_char) & CHAR_META)
475 meta_prefix_char = make_number (27); 419 meta_prefix_char = make_number (27);
476 event_meta_map = get_keymap (access_keymap (map, meta_prefix_char, 420 event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
477 t_ok, noinherit, autoload), 421 noinherit, autoload);
478 0, autoload); 422 event_meta_map = get_keymap (event_meta_binding, 0, autoload);
479 UNGCPRO; 423 UNGCPRO;
480 if (CONSP (event_meta_map)) 424 if (CONSP (event_meta_map))
481 { 425 {
@@ -486,8 +430,8 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
486 /* Set IDX to t, so that we only find a default binding. */ 430 /* Set IDX to t, so that we only find a default binding. */
487 idx = Qt; 431 idx = Qt;
488 else 432 else
489 /* We know there is no binding. */ 433 /* An explicit nil binding, or no binding at all. */
490 return Qnil; 434 return NILP (event_meta_binding) ? Qnil : Qunbound;
491 } 435 }
492 436
493 /* t_binding is where we put a default binding that applies, 437 /* t_binding is where we put a default binding that applies,
@@ -495,25 +439,52 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
495 for this key sequence. */ 439 for this key sequence. */
496 { 440 {
497 Lisp_Object tail; 441 Lisp_Object tail;
498 Lisp_Object t_binding = Qnil; 442 Lisp_Object t_binding = Qunbound;
443 Lisp_Object retval = Qunbound;
444 Lisp_Object retval_tail = Qnil;
499 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 445 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
500 446
501 GCPRO4 (map, tail, idx, t_binding); 447 GCPRO4 (tail, idx, t_binding, retval);
502 448
503 for (tail = XCDR (map); 449 for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
504 (CONSP (tail) 450 (CONSP (tail)
505 || (tail = get_keymap (tail, 0, autoload), CONSP (tail))); 451 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
506 tail = XCDR (tail)) 452 tail = XCDR (tail))
507 { 453 {
508 Lisp_Object binding; 454 /* Qunbound in VAL means we have found no binding. */
455 Lisp_Object val = Qunbound;
456 Lisp_Object binding = XCAR (tail);
457 Lisp_Object submap = get_keymap (binding, 0, autoload);
509 458
510 binding = XCAR (tail); 459 if (EQ (binding, Qkeymap))
511 if (SYMBOLP (binding))
512 { 460 {
513 /* If NOINHERIT, stop finding prefix definitions 461 if (noinherit || NILP (retval))
514 after we pass a second occurrence of the `keymap' symbol. */ 462 /* If NOINHERIT, stop here, the rest is inherited. */
515 if (noinherit && EQ (binding, Qkeymap)) 463 break;
516 RETURN_UNGCPRO (Qnil); 464 else if (!EQ (retval, Qunbound))
465 {
466 Lisp_Object parent_entry;
467 eassert (KEYMAPP (retval));
468 parent_entry
469 = get_keymap (access_keymap_1 (tail, idx,
470 t_ok, 0, autoload),
471 0, autoload);
472 if (KEYMAPP (parent_entry))
473 {
474 if (CONSP (retval_tail))
475 XSETCDR (retval_tail, parent_entry);
476 else
477 {
478 retval_tail = Fcons (retval, parent_entry);
479 retval = Fcons (Qkeymap, retval_tail);
480 }
481 }
482 break;
483 }
484 }
485 else if (CONSP (submap))
486 {
487 val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
517 } 488 }
518 else if (CONSP (binding)) 489 else if (CONSP (binding))
519 { 490 {
@@ -556,23 +527,47 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au
556 (i.e. it shadows any parent binding but not bindings in 527 (i.e. it shadows any parent binding but not bindings in
557 keymaps of lower precedence). */ 528 keymaps of lower precedence). */
558 val = Qnil; 529 val = Qnil;
530
559 val = get_keyelt (val, autoload); 531 val = get_keyelt (val, autoload);
560 if (KEYMAPP (val)) 532
561 fix_submap_inheritance (map, idx, val); 533 if (!KEYMAPP (val))
562 RETURN_UNGCPRO (val); 534 {
535 if (NILP (retval) || EQ (retval, Qunbound))
536 retval = val;
537 if (!NILP (val))
538 break; /* Shadows everything that follows. */
539 }
540 else if (NILP (retval) || EQ (retval, Qunbound))
541 retval = val;
542 else if (CONSP (retval_tail))
543 {
544 XSETCDR (retval_tail, Fcons (val, Qnil));
545 retval_tail = XCDR (retval_tail);
546 }
547 else
548 {
549 retval_tail = Fcons (val, Qnil);
550 retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
551 }
563 } 552 }
564 QUIT; 553 QUIT;
565 } 554 }
566 UNGCPRO; 555 UNGCPRO;
567 return get_keyelt (t_binding, autoload); 556 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
568 } 557 }
569} 558}
570 559
560Lisp_Object
561access_keymap (Lisp_Object map, Lisp_Object idx,
562 int t_ok, int noinherit, int autoload)
563{
564 Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
565 return EQ (val, Qunbound) ? Qnil : val;
566}
567
571static void 568static void
572map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data) 569map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
573{ 570{
574 /* We should maybe try to detect bindings shadowed by previous
575 ones and things like that. */
576 if (EQ (val, Qt)) 571 if (EQ (val, Qt))
577 val = Qnil; 572 val = Qnil;
578 (*fun) (key, val, args, data); 573 (*fun) (key, val, args, data);
@@ -583,8 +578,8 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
583{ 578{
584 if (!NILP (val)) 579 if (!NILP (val))
585 { 580 {
586 map_keymap_function_t fun = 581 map_keymap_function_t fun
587 (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; 582 = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
588 args = XCDR (args); 583 args = XCDR (args);
589 /* If the key is a range, make a copy since map_char_table modifies 584 /* If the key is a range, make a copy since map_char_table modifies
590 it in place. */ 585 it in place. */
@@ -612,7 +607,9 @@ map_keymap_internal (Lisp_Object map,
612 { 607 {
613 Lisp_Object binding = XCAR (tail); 608 Lisp_Object binding = XCAR (tail);
614 609
615 if (CONSP (binding)) 610 if (KEYMAPP (binding)) /* An embedded parent. */
611 break;
612 else if (CONSP (binding))
616 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data); 613 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
617 else if (VECTORP (binding)) 614 else if (VECTORP (binding))
618 { 615 {
@@ -644,7 +641,7 @@ map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
644 call2 (fun, key, val); 641 call2 (fun, key, val);
645} 642}
646 643
647/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well. 644/* Same as map_keymap_internal, but traverses parent keymaps as well.
648 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */ 645 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
649void 646void
650map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload) 647map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
@@ -654,8 +651,15 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *
654 map = get_keymap (map, 1, autoload); 651 map = get_keymap (map, 1, autoload);
655 while (CONSP (map)) 652 while (CONSP (map))
656 { 653 {
657 map = map_keymap_internal (map, fun, args, data); 654 if (KEYMAPP (XCAR (map)))
658 map = get_keymap (map, 0, autoload); 655 {
656 map_keymap (XCAR (map), fun, args, data, autoload);
657 map = XCDR (map);
658 }
659 else
660 map = map_keymap_internal (map, fun, args, data);
661 if (!CONSP (map))
662 map = get_keymap (map, 0, autoload);
659 } 663 }
660 UNGCPRO; 664 UNGCPRO;
661} 665}
@@ -791,16 +795,10 @@ get_keyelt (Lisp_Object object, int autoload)
791 } 795 }
792 796
793 /* If the contents are (KEYMAP . ELEMENT), go indirect. */ 797 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
798 else if (KEYMAPP (XCAR (object)))
799 error ("Wow, indirect keymap entry!!");
794 else 800 else
795 { 801 return object;
796 struct gcpro gcpro1;
797 Lisp_Object map;
798 GCPRO1 (object);
799 map = get_keymap (Fcar_safe (object), 0, autoload);
800 UNGCPRO;
801 return (!CONSP (map) ? object /* Invalid keymap */
802 : access_keymap (map, Fcdr (object), 0, 0, autoload));
803 }
804 } 802 }
805} 803}
806 804
@@ -811,6 +809,9 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
811 where_is_cache = Qnil; 809 where_is_cache = Qnil;
812 where_is_cache_keymaps = Qt; 810 where_is_cache_keymaps = Qt;
813 811
812 if (EQ (idx, Qkeymap))
813 error ("`keymap' is reserved for embedded parent maps");
814
814 /* If we are preparing to dump, and DEF is a menu element 815 /* If we are preparing to dump, and DEF is a menu element
815 with a menu item indicator, copy it to ensure it is not pure. */ 816 with a menu item indicator, copy it to ensure it is not pure. */
816 if (CONSP (def) && PURE_P (def) 817 if (CONSP (def) && PURE_P (def)
@@ -903,7 +904,16 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
903 } 904 }
904 else if (CONSP (elt)) 905 else if (CONSP (elt))
905 { 906 {
906 if (EQ (idx, XCAR (elt))) 907 if (EQ (Qkeymap, XCAR (elt)))
908 { /* A sub keymap. This might be due to a lookup that found
909 two matching bindings (maybe because of a sub keymap).
910 It almost never happens (since the second binding normally
911 only happens in the inherited part of the keymap), but
912 if it does, we want to update the sub-keymap since the
913 main one might be temporary (built by access_keymap). */
914 tail = insertion_point = elt;
915 }
916 else if (EQ (idx, XCAR (elt)))
907 { 917 {
908 CHECK_IMPURE (elt); 918 CHECK_IMPURE (elt);
909 XSETCDR (elt, def); 919 XSETCDR (elt, def);
@@ -1068,7 +1078,13 @@ is not copied. */)
1068 ASET (elt, i, copy_keymap_item (AREF (elt, i))); 1078 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1069 } 1079 }
1070 else if (CONSP (elt)) 1080 else if (CONSP (elt))
1071 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); 1081 {
1082 if (EQ (XCAR (elt), Qkeymap))
1083 /* This is a sub keymap. */
1084 elt = Fcopy_keymap (elt);
1085 else
1086 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1087 }
1072 XSETCDR (tail, Fcons (elt, Qnil)); 1088 XSETCDR (tail, Fcons (elt, Qnil));
1073 tail = XCDR (tail); 1089 tail = XCDR (tail);
1074 keymap = XCDR (keymap); 1090 keymap = XCDR (keymap);
@@ -1234,23 +1250,15 @@ remapping in all currently active keymaps. */)
1234 ASET (command_remapping_vector, 1, command); 1250 ASET (command_remapping_vector, 1, command);
1235 1251
1236 if (NILP (keymaps)) 1252 if (NILP (keymaps))
1237 return Fkey_binding (command_remapping_vector, Qnil, Qt, position); 1253 command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1238 else 1254 else
1239 { 1255 command = Flookup_key (Fcons (Qkeymap, keymaps),
1240 Lisp_Object maps, binding; 1256 command_remapping_vector, Qnil);
1241 1257 return INTEGERP (command) ? Qnil : command;
1242 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1243 {
1244 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1245 if (!NILP (binding) && !INTEGERP (binding))
1246 return binding;
1247 }
1248 return Qnil;
1249 }
1250} 1258}
1251 1259
1252/* Value is number if KEY is too long; nil if valid but has no definition. */ 1260/* Value is number if KEY is too long; nil if valid but has no definition. */
1253/* GC is possible in this function if it autoloads a keymap. */ 1261/* GC is possible in this function. */
1254 1262
1255DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, 1263DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1256 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. 1264 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
@@ -1325,10 +1333,6 @@ define_as_prefix (Lisp_Object keymap, Lisp_Object c)
1325 Lisp_Object cmd; 1333 Lisp_Object cmd;
1326 1334
1327 cmd = Fmake_sparse_keymap (Qnil); 1335 cmd = Fmake_sparse_keymap (Qnil);
1328 /* If this key is defined as a prefix in an inherited keymap,
1329 make it a prefix in this map, and make its definition
1330 inherit the other prefix definition. */
1331 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1332 store_in_keymap (keymap, c, cmd); 1336 store_in_keymap (keymap, c, cmd);
1333 1337
1334 return cmd; 1338 return cmd;
@@ -1530,7 +1534,7 @@ like in the respective argument of `key-binding'. */)
1530{ 1534{
1531 int count = SPECPDL_INDEX (); 1535 int count = SPECPDL_INDEX ();
1532 1536
1533 Lisp_Object keymaps; 1537 Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1534 1538
1535 /* If a mouse click position is given, our variables are based on 1539 /* If a mouse click position is given, our variables are based on
1536 the buffer clicked on, not the current buffer. So we may have to 1540 the buffer clicked on, not the current buffer. So we may have to
@@ -1560,12 +1564,11 @@ like in the respective argument of `key-binding'. */)
1560 } 1564 }
1561 } 1565 }
1562 1566
1563 keymaps = Fcons (current_global_map, Qnil);
1564
1565 if (!NILP (olp)) 1567 if (!NILP (olp))
1566 { 1568 {
1567 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) 1569 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1568 keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); 1570 keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map),
1571 keymaps);
1569 /* The doc said that overriding-terminal-local-map should 1572 /* The doc said that overriding-terminal-local-map should
1570 override overriding-local-map. The code used them both, 1573 override overriding-local-map. The code used them both,
1571 but it seems clearer to use just one. rms, jan 2005. */ 1574 but it seems clearer to use just one. rms, jan 2005. */
@@ -1576,23 +1579,19 @@ like in the respective argument of `key-binding'. */)
1576 { 1579 {
1577 Lisp_Object *maps; 1580 Lisp_Object *maps;
1578 int nmaps, i; 1581 int nmaps, i;
1579 1582 EMACS_INT pt
1580 Lisp_Object keymap, local_map; 1583 = INTEGERP (position) ? XINT (position)
1581 EMACS_INT pt;
1582
1583 pt = INTEGERP (position) ? XINT (position)
1584 : MARKERP (position) ? marker_position (position) 1584 : MARKERP (position) ? marker_position (position)
1585 : PT; 1585 : PT;
1586 1586 /* This usually returns the buffer's local map,
1587 /* Get the buffer local maps, possibly overriden by text or 1587 but that can be overridden by a `local-map' property. */
1588 overlay properties */ 1588 Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
1589 1589 /* This returns nil unless there is a `keymap' property. */
1590 local_map = get_local_map (pt, current_buffer, Qlocal_map); 1590 Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap);
1591 keymap = get_local_map (pt, current_buffer, Qkeymap);
1592 1591
1593 if (CONSP (position)) 1592 if (CONSP (position))
1594 { 1593 {
1595 Lisp_Object string; 1594 Lisp_Object string = POSN_STRING (position);
1596 1595
1597 /* For a mouse click, get the local text-property keymap 1596 /* For a mouse click, get the local text-property keymap
1598 of the place clicked on, rather than point. */ 1597 of the place clicked on, rather than point. */
@@ -1619,8 +1618,7 @@ like in the respective argument of `key-binding'. */)
1619 consider `local-map' and `keymap' properties of 1618 consider `local-map' and `keymap' properties of
1620 that string. */ 1619 that string. */
1621 1620
1622 if (string = POSN_STRING (position), 1621 if (CONSP (string) && STRINGP (XCAR (string)))
1623 (CONSP (string) && STRINGP (XCAR (string))))
1624 { 1622 {
1625 Lisp_Object pos, map; 1623 Lisp_Object pos, map;
1626 1624
@@ -1691,12 +1689,7 @@ specified buffer position instead of point are used.
1691 */) 1689 */)
1692 (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position) 1690 (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
1693{ 1691{
1694 Lisp_Object *maps, value; 1692 Lisp_Object value;
1695 int nmaps, i;
1696 struct gcpro gcpro1, gcpro2;
1697 int count = SPECPDL_INDEX ();
1698
1699 GCPRO2 (key, position);
1700 1693
1701 if (NILP (position) && VECTORP (key)) 1694 if (NILP (position) && VECTORP (key))
1702 { 1695 {
@@ -1715,145 +1708,9 @@ specified buffer position instead of point are used.
1715 } 1708 }
1716 } 1709 }
1717 1710
1718 /* Key sequences beginning with mouse clicks 1711 value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
1719 are read using the keymaps of the buffer clicked on, not 1712 key, accept_default);
1720 the current buffer. So we may have to switch the buffer
1721 here. */
1722 1713
1723 if (CONSP (position))
1724 {
1725 Lisp_Object window;
1726
1727 window = POSN_WINDOW (position);
1728
1729 if (WINDOWP (window)
1730 && BUFFERP (XWINDOW (window)->buffer)
1731 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1732 {
1733 /* Arrange to go back to the original buffer once we're done
1734 processing the key sequence. We don't use
1735 save_excursion_{save,restore} here, in analogy to
1736 `read-key-sequence' to avoid saving point. Maybe this
1737 would not be a problem here, but it is easier to keep
1738 things the same.
1739 */
1740
1741 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1742
1743 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1744 }
1745 }
1746
1747 if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1748 {
1749 value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map),
1750 key, accept_default);
1751 if (! NILP (value) && !INTEGERP (value))
1752 goto done;
1753 }
1754 else if (! NILP (Voverriding_local_map))
1755 {
1756 value = Flookup_key (Voverriding_local_map, key, accept_default);
1757 if (! NILP (value) && !INTEGERP (value))
1758 goto done;
1759 }
1760 else
1761 {
1762 Lisp_Object keymap, local_map;
1763 EMACS_INT pt;
1764
1765 pt = INTEGERP (position) ? XINT (position)
1766 : MARKERP (position) ? marker_position (position)
1767 : PT;
1768
1769 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1770 keymap = get_local_map (pt, current_buffer, Qkeymap);
1771
1772 if (CONSP (position))
1773 {
1774 Lisp_Object string;
1775
1776 /* For a mouse click, get the local text-property keymap
1777 of the place clicked on, rather than point. */
1778
1779 if (POSN_INBUFFER_P (position))
1780 {
1781 Lisp_Object pos;
1782
1783 pos = POSN_BUFFER_POSN (position);
1784 if (INTEGERP (pos)
1785 && XINT (pos) >= BEG && XINT (pos) <= Z)
1786 {
1787 local_map = get_local_map (XINT (pos),
1788 current_buffer, Qlocal_map);
1789
1790 keymap = get_local_map (XINT (pos),
1791 current_buffer, Qkeymap);
1792 }
1793 }
1794
1795 /* If on a mode line string with a local keymap,
1796 or for a click on a string, i.e. overlay string or a
1797 string displayed via the `display' property,
1798 consider `local-map' and `keymap' properties of
1799 that string. */
1800
1801 if (string = POSN_STRING (position),
1802 (CONSP (string) && STRINGP (XCAR (string))))
1803 {
1804 Lisp_Object pos, map;
1805
1806 pos = XCDR (string);
1807 string = XCAR (string);
1808 if (INTEGERP (pos)
1809 && XINT (pos) >= 0
1810 && XINT (pos) < SCHARS (string))
1811 {
1812 map = Fget_text_property (pos, Qlocal_map, string);
1813 if (!NILP (map))
1814 local_map = map;
1815
1816 map = Fget_text_property (pos, Qkeymap, string);
1817 if (!NILP (map))
1818 keymap = map;
1819 }
1820 }
1821
1822 }
1823
1824 if (! NILP (keymap))
1825 {
1826 value = Flookup_key (keymap, key, accept_default);
1827 if (! NILP (value) && !INTEGERP (value))
1828 goto done;
1829 }
1830
1831 nmaps = current_minor_maps (0, &maps);
1832 /* Note that all these maps are GCPRO'd
1833 in the places where we found them. */
1834
1835 for (i = 0; i < nmaps; i++)
1836 if (! NILP (maps[i]))
1837 {
1838 value = Flookup_key (maps[i], key, accept_default);
1839 if (! NILP (value) && !INTEGERP (value))
1840 goto done;
1841 }
1842
1843 if (! NILP (local_map))
1844 {
1845 value = Flookup_key (local_map, key, accept_default);
1846 if (! NILP (value) && !INTEGERP (value))
1847 goto done;
1848 }
1849 }
1850
1851 value = Flookup_key (current_global_map, key, accept_default);
1852
1853 done:
1854 unbind_to (count, Qnil);
1855
1856 UNGCPRO;
1857 if (NILP (value) || INTEGERP (value)) 1714 if (NILP (value) || INTEGERP (value))
1858 return Qnil; 1715 return Qnil;
1859 1716
@@ -3829,31 +3686,6 @@ don't alter it yourself. */);
3829 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); 3686 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3830 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map); 3687 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3831 3688
3832 DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map,
3833 doc: /* Local keymap for minibuffer input with completion. */);
3834 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3835 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3836
3837 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3838 Vminibuffer_local_filename_completion_map,
3839 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3840 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3841 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3842 Vminibuffer_local_completion_map);
3843
3844
3845 DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map,
3846 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
3847 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3848 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3849 Vminibuffer_local_completion_map);
3850
3851 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
3852 Vminibuffer_local_filename_must_match_map,
3853 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3854 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
3855 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
3856 Vminibuffer_local_must_match_map);
3857 3689
3858 DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist, 3690 DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
3859 doc: /* Alist of keymaps to use for minor modes. 3691 doc: /* Alist of keymaps to use for minor modes.
@@ -3922,6 +3754,7 @@ preferred. */);
3922 defsubr (&Sset_keymap_parent); 3754 defsubr (&Sset_keymap_parent);
3923 defsubr (&Smake_keymap); 3755 defsubr (&Smake_keymap);
3924 defsubr (&Smake_sparse_keymap); 3756 defsubr (&Smake_sparse_keymap);
3757 defsubr (&Smake_composed_keymap);
3925 defsubr (&Smap_keymap_internal); 3758 defsubr (&Smap_keymap_internal);
3926 defsubr (&Smap_keymap); 3759 defsubr (&Smap_keymap);
3927 defsubr (&Scopy_keymap); 3760 defsubr (&Scopy_keymap);