comparison src/keymap.c @ 21241:31bd04a792c2

(fix_submap_inheritance, get_keyelt, store_in_keymap, copy-keymap, where_is_internal_1): Support new format for menu items. (syms_of_keymap): New symbol `menu-item'.
author Richard M. Stallman <rms@gnu.org>
date Sat, 21 Mar 1998 05:53:36 +0000
parents 4aeabf3b8f98
children 50929073a0ba
comparison
equal deleted inserted replaced
21240:bff697e03fe0 21241:31bd04a792c2
87 when nil was stored here. 87 when nil was stored here.
88 This is used to speed up recomputation of menu key equivalents 88 This is used to speed up recomputation of menu key equivalents
89 when Emacs starts up. t means don't record anything here. */ 89 when Emacs starts up. t means don't record anything here. */
90 Lisp_Object Vdefine_key_rebound_commands; 90 Lisp_Object Vdefine_key_rebound_commands;
91 91
92 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii; 92 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
93 93
94 /* A char with the CHAR_META bit set in a vector or the 0200 bit set 94 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
95 in a string key sequence is equivalent to prefixing with this 95 in a string key sequence is equivalent to prefixing with this
96 character. */ 96 character. */
97 extern Lisp_Object meta_prefix_char; 97 extern Lisp_Object meta_prefix_char;
366 Lisp_Object map_parent, parent_entry; 366 Lisp_Object map_parent, parent_entry;
367 367
368 /* SUBMAP is a cons that we found as a key binding. 368 /* SUBMAP is a cons that we found as a key binding.
369 Discard the other things found in a menu key binding. */ 369 Discard the other things found in a menu key binding. */
370 370
371 if (CONSP (submap) 371 if CONSP (submap)
372 && STRINGP (XCONS (submap)->car)) 372 {
373 { 373 /* May be an old format menu item */
374 submap = XCONS (submap)->cdr; 374 if STRINGP (XCONS (submap)->car)
375 /* Also remove a menu help string, if any, 375 {
376 following the menu item name. */ 376 submap = XCONS (submap)->cdr;
377 if (CONSP (submap) && STRINGP (XCONS (submap)->car)) 377 /* Also remove a menu help string, if any,
378 submap = XCONS (submap)->cdr; 378 following the menu item name. */
379 /* Also remove the sublist that caches key equivalences, if any. */ 379 if (CONSP (submap) && STRINGP (XCONS (submap)->car))
380 if (CONSP (submap)
381 && CONSP (XCONS (submap)->car))
382 {
383 Lisp_Object carcar;
384 carcar = XCONS (XCONS (submap)->car)->car;
385 if (NILP (carcar) || VECTORP (carcar))
386 submap = XCONS (submap)->cdr; 380 submap = XCONS (submap)->cdr;
381 /* Also remove the sublist that caches key equivalences, if any. */
382 if (CONSP (submap)
383 && CONSP (XCONS (submap)->car))
384 {
385 Lisp_Object carcar;
386 carcar = XCONS (XCONS (submap)->car)->car;
387 if (NILP (carcar) || VECTORP (carcar))
388 submap = XCONS (submap)->cdr;
389 }
390 }
391
392 /* Or a new format menu item */
393 else if (EQ (XCONS (submap)->car, Qmenu_item)
394 && CONSP (XCONS (submap)->cdr))
395 {
396 submap = XCONS (XCONS (submap)->cdr)->cdr;
397 if (CONSP (submap))
398 submap = XCONS (submap)->car;
387 } 399 }
388 } 400 }
389 401
390 /* If it isn't a keymap now, there's no work to do. */ 402 /* If it isn't a keymap now, there's no work to do. */
391 if (! CONSP (submap) 403 if (! CONSP (submap)
550 } 562 }
551 else 563 else
552 object = access_keymap (map, key, 0, 0); 564 object = access_keymap (map, key, 0, 0);
553 } 565 }
554 566
567 else if (!(CONSP (object)))
568 /* This is really the value. */
569 return object;
570
555 /* If the keymap contents looks like (STRING . DEFN), 571 /* If the keymap contents looks like (STRING . DEFN),
556 use DEFN. 572 use DEFN.
557 Keymap alist elements like (CHAR MENUSTRING . DEFN) 573 Keymap alist elements like (CHAR MENUSTRING . DEFN)
558 will be used by HierarKey menus. */ 574 will be used by HierarKey menus. */
559 else if (CONSP (object) 575 else if (STRINGP (XCONS (object)->car))
560 && STRINGP (XCONS (object)->car))
561 { 576 {
562 object = XCONS (object)->cdr; 577 object = XCONS (object)->cdr;
563 /* Also remove a menu help string, if any, 578 /* Also remove a menu help string, if any,
564 following the menu item name. */ 579 following the menu item name. */
565 if (CONSP (object) && STRINGP (XCONS (object)->car)) 580 if (CONSP (object) && STRINGP (XCONS (object)->car))
573 if (NILP (carcar) || VECTORP (carcar)) 588 if (NILP (carcar) || VECTORP (carcar))
574 object = XCONS (object)->cdr; 589 object = XCONS (object)->cdr;
575 } 590 }
576 } 591 }
577 592
593 /* If the keymap contents looks like (menu-item name . DEFN)
594 or (menu-item name DEFN ...) then use DEFN.
595 This is a new format menu item.
596 */
597 else if (EQ (XCONS (object)->car, Qmenu_item)
598 && CONSP (XCONS (object)->cdr))
599 {
600 object = XCONS (XCONS (object)->cdr)->cdr;
601 if (CONSP (object))
602 object = XCONS (object)->car;
603 }
604
578 else 605 else
579 /* Anything else is really the value. */ 606 /* Anything else is really the value. */
580 return object; 607 return object;
581 } 608 }
582 } 609 }
586 Lisp_Object keymap; 613 Lisp_Object keymap;
587 register Lisp_Object idx; 614 register Lisp_Object idx;
588 register Lisp_Object def; 615 register Lisp_Object def;
589 { 616 {
590 /* If we are preparing to dump, and DEF is a menu element 617 /* If we are preparing to dump, and DEF is a menu element
591 with a menu item string, copy it to ensure it is not pure. */ 618 with a menu item indicator, copy it to ensure it is not pure. */
592 if (CONSP (def) && PURE_P (def) && STRINGP (XCONS (def)->car)) 619 if (CONSP (def) && PURE_P (def)
620 && (EQ (XCONS (def)->car, Qmenu_item) || STRINGP (XCONS (def)->car)))
593 def = Fcons (XCONS (def)->car, XCONS (def)->cdr); 621 def = Fcons (XCONS (def)->car, XCONS (def)->cdr);
594 622
595 if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap)) 623 if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
596 error ("attempt to define a key in a non-keymap"); 624 error ("attempt to define a key in a non-keymap");
597 625
729 if (!SYMBOLP (XVECTOR (elt)->contents[i]) 757 if (!SYMBOLP (XVECTOR (elt)->contents[i])
730 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i]))) 758 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
731 XVECTOR (elt)->contents[i] 759 XVECTOR (elt)->contents[i]
732 = Fcopy_keymap (XVECTOR (elt)->contents[i]); 760 = Fcopy_keymap (XVECTOR (elt)->contents[i]);
733 } 761 }
734 else if (CONSP (elt)) 762 else if (CONSP (elt) && CONSP (XCONS (elt)->cdr))
735 { 763 {
736 /* Skip the optional menu string. */ 764 Lisp_Object tem;
737 if (CONSP (XCONS (elt)->cdr) 765 tem = XCONS (elt)->cdr;
738 && STRINGP (XCONS (XCONS (elt)->cdr)->car)) 766
767 /* Is this a new format menu item. */
768 if (EQ (XCONS (tem)->car,Qmenu_item))
739 { 769 {
740 Lisp_Object tem; 770 /* Copy cell with menu-item marker. */
741 771 XCONS (elt)->cdr
742 /* Copy the cell, since copy-alist didn't go this deep. */ 772 = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
743 XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
744 XCONS (XCONS (elt)->cdr)->cdr);
745 elt = XCONS (elt)->cdr; 773 elt = XCONS (elt)->cdr;
746 774 tem = XCONS (elt)->cdr;
747 /* Also skip the optional menu help string. */ 775 if (CONSP (tem))
748 if (CONSP (XCONS (elt)->cdr)
749 && STRINGP (XCONS (XCONS (elt)->cdr)->car))
750 { 776 {
751 XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, 777 /* Copy cell with menu-item name. */
752 XCONS (XCONS (elt)->cdr)->cdr); 778 XCONS (elt)->cdr
779 = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
753 elt = XCONS (elt)->cdr; 780 elt = XCONS (elt)->cdr;
781 tem = XCONS (elt)->cdr;
782 };
783 if (CONSP (tem))
784 {
785 /* Copy cell with binding and if the binding is a keymap,
786 copy that. */
787 XCONS (elt)->cdr
788 = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
789 elt = XCONS (elt)->cdr;
790 tem = XCONS (elt)->car;
791 if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
792 XCONS (elt)->car = Fcopy_keymap (tem);
793 tem = XCONS (elt)->cdr;
794 if (CONSP (tem) && CONSP (XCONS (tem)->car))
795 /* Delete cache for key equivalences. */
796 XCONS (elt)->cdr = XCONS (tem)->cdr;
754 } 797 }
755 /* There may also be a list that caches key equivalences.
756 Just delete it for the new keymap. */
757 if (CONSP (XCONS (elt)->cdr)
758 && CONSP (XCONS (XCONS (elt)->cdr)->car)
759 && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
760 || VECTORP (tem)))
761 XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
762 } 798 }
763 if (CONSP (elt) 799 else
764 && ! SYMBOLP (XCONS (elt)->cdr) 800 {
765 && ! NILP (Fkeymapp (XCONS (elt)->cdr))) 801 /* It may be an old fomat menu item.
766 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); 802 Skip the optional menu string.
767 } 803 */
768 } 804 if (STRINGP (XCONS (tem)->car))
769 805 {
806 /* Copy the cell, since copy-alist didn't go this deep. */
807 XCONS (elt)->cdr
808 = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
809 elt = XCONS (elt)->cdr;
810 tem = XCONS (elt)->cdr;
811 /* Also skip the optional menu help string. */
812 if (CONSP (tem) && STRINGP (XCONS (tem)->car))
813 {
814 XCONS (elt)->cdr
815 = Fcons (XCONS (tem)->car, XCONS (tem)->cdr);
816 elt = XCONS (elt)->cdr;
817 tem = XCONS (elt)->cdr;
818 }
819 /* There may also be a list that caches key equivalences.
820 Just delete it for the new keymap. */
821 if (CONSP (tem)
822 && CONSP (XCONS (tem)->car)
823 && (NILP (XCONS (XCONS (tem)->car)->car)
824 || VECTORP (XCONS (XCONS (tem)->car)->car)))
825 XCONS (elt)->cdr = XCONS (tem)->cdr;
826 }
827 if (CONSP (elt)
828 && ! SYMBOLP (XCONS (elt)->cdr)
829 && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
830 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
831 }
832
833 }
834 }
835
770 return copy; 836 return copy;
771 } 837 }
772 838
773 /* Simple Keymap mutators and accessors. */ 839 /* Simple Keymap mutators and accessors. */
774 840
2133 if (!NILP (tem)) 2199 if (!NILP (tem))
2134 definition = access_keymap (map, Fcdr (definition), 0, 0); 2200 definition = access_keymap (map, Fcdr (definition), 0, 0);
2135 else 2201 else
2136 break; 2202 break;
2137 } 2203 }
2138 /* If the contents are (STRING ...), reject. */ 2204 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2139 if (CONSP (definition) 2205 if (CONSP (definition)
2140 && STRINGP (XCONS (definition)->car)) 2206 && (EQ (XCONS (definition)->car,Qmenu_item)
2207 || STRINGP (XCONS (definition)->car)))
2141 return Qnil; 2208 return Qnil;
2142 } 2209 }
2143 else 2210 else
2144 binding = get_keyelt (binding, 0); 2211 binding = get_keyelt (binding, 0);
2145 } 2212 }
3204 staticpro (&Qkeymapp); 3271 staticpro (&Qkeymapp);
3205 3272
3206 Qnon_ascii = intern ("non-ascii"); 3273 Qnon_ascii = intern ("non-ascii");
3207 staticpro (&Qnon_ascii); 3274 staticpro (&Qnon_ascii);
3208 3275
3276 Qmenu_item = intern ("menu-item");
3277 staticpro (&Qmenu_item);
3278
3209 defsubr (&Skeymapp); 3279 defsubr (&Skeymapp);
3210 defsubr (&Skeymap_parent); 3280 defsubr (&Skeymap_parent);
3211 defsubr (&Sset_keymap_parent); 3281 defsubr (&Sset_keymap_parent);
3212 defsubr (&Smake_keymap); 3282 defsubr (&Smake_keymap);
3213 defsubr (&Smake_sparse_keymap); 3283 defsubr (&Smake_sparse_keymap);