692 |
692 |
693 <resource: #menu> |
693 <resource: #menu> |
694 |
694 |
695 ^ |
695 ^ |
696 #(Menu |
696 #(Menu |
697 ( |
697 ( |
698 (MenuItem |
698 (MenuItem |
699 activeHelpKey: editCut |
699 activeHelpKey: editCut |
700 enabled: hasSelectionChannel |
700 enabled: hasSelectionChannel |
701 label: 'Cut' |
701 label: 'Cut' |
702 itemValue: doCut |
702 itemValue: doCut |
703 translateLabel: true |
703 translateLabel: true |
704 shortcutKey: Cut |
704 shortcutKey: Cut |
705 ) |
705 ) |
706 (MenuItem |
706 (MenuItem |
707 activeHelpKey: editCopy |
707 activeHelpKey: editCopy |
708 enabled: hasSelectionChannel |
708 enabled: hasSelectionChannel |
709 label: 'Copy' |
709 label: 'Copy' |
710 itemValue: doCopy |
710 itemValue: doCopy |
711 translateLabel: true |
711 translateLabel: true |
712 shortcutKey: Copy |
712 shortcutKey: Copy |
713 ) |
713 ) |
714 (MenuItem |
714 (MenuItem |
715 activeHelpKey: editPaste |
715 activeHelpKey: editPaste |
716 enabled: canPasteHolder |
716 enabled: canPasteHolder |
717 label: 'Paste' |
717 label: 'Paste' |
718 itemValue: doPaste |
718 itemValue: doPaste |
719 translateLabel: true |
719 translateLabel: true |
720 shortcutKey: Paste |
720 shortcutKey: Paste |
721 ) |
721 ) |
722 (MenuItem |
722 (MenuItem |
723 activeHelpKey: editDelete |
723 activeHelpKey: editDelete |
724 enabled: hasSelectionChannel |
724 enabled: hasSelectionChannel |
725 label: 'Delete' |
725 label: 'Delete' |
726 itemValue: doDelete |
726 itemValue: doDelete |
727 translateLabel: true |
727 translateLabel: true |
728 isVisible: false |
728 isVisible: false |
729 ) |
729 ) |
730 (MenuItem |
730 (MenuItem |
731 label: '-' |
731 label: '-' |
732 ) |
732 ) |
733 (MenuItem |
733 (MenuItem |
734 activeHelpKey: editMoveUp |
734 activeHelpKey: makeLinkedMenu |
735 enabled: enableMovingUpOrDownHolder |
735 enabled: hasNonLinkedMenuSelectedHolder |
736 label: 'Move Up' |
736 label: 'Make Linked Menu...' |
737 itemValue: doMoveUpOrDown: |
737 itemValue: doMakeLinkedMenu |
738 translateLabel: true |
738 translateLabel: true |
739 startGroup: right |
739 ) |
740 shortcutKey: CtrlCursorUp |
740 (MenuItem |
741 labelImage: (ResourceRetriever Icon upIcon 'Move Up') |
741 label: '-' |
742 argument: up |
742 ) |
743 ) |
743 (MenuItem |
744 (MenuItem |
744 activeHelpKey: editMoveUp |
745 activeHelpKey: editMoveDown |
745 enabled: enableMovingUpOrDownHolder |
746 enabled: enableMovingUpOrDownHolder |
746 label: 'Move Up' |
747 label: 'Move Down' |
747 itemValue: doMoveUpOrDown: |
748 itemValue: doMoveUpOrDown: |
748 translateLabel: true |
749 translateLabel: true |
749 startGroup: right |
750 shortcutKey: CtrlCursorDown |
750 shortcutKey: CtrlCursorUp |
751 labelImage: (ResourceRetriever Icon downIcon 'Move Down') |
751 labelImage: (ResourceRetriever Icon upIcon 'Move Up') |
752 argument: down |
752 argument: up |
753 ) |
753 ) |
754 (MenuItem |
754 (MenuItem |
755 activeHelpKey: editMoveIn |
755 activeHelpKey: editMoveDown |
756 enabled: enableMovingInHolder |
756 enabled: enableMovingUpOrDownHolder |
757 label: 'Move Into Next' |
757 label: 'Move Down' |
758 itemValue: doMoveIn: |
758 itemValue: doMoveUpOrDown: |
759 translateLabel: true |
759 translateLabel: true |
760 shortcutKey: CtrlCursorRight |
760 shortcutKey: CtrlCursorDown |
761 labelImage: (ResourceRetriever Icon downRightIcon 'Move Into Next') |
761 labelImage: (ResourceRetriever Icon downIcon 'Move Down') |
762 argument: inNext |
762 argument: down |
763 ) |
763 ) |
764 (MenuItem |
764 (MenuItem |
765 activeHelpKey: editMoveInAbove |
765 activeHelpKey: editMoveIn |
766 enabled: enableMovingInAboveHolder |
766 enabled: enableMovingInHolder |
767 label: 'Move Into Previous' |
767 label: 'Move Into Next' |
768 itemValue: doMoveIn: |
768 itemValue: doMoveIn: |
769 translateLabel: true |
769 translateLabel: true |
770 labelImage: (ResourceRetriever Icon upRightIcon 'Move Into Previous' ) |
770 shortcutKey: CtrlCursorRight |
771 argument: inPrev |
771 labelImage: (ResourceRetriever Icon downRightIcon 'Move Into Next') |
772 ) |
772 argument: inNext |
773 (MenuItem |
773 ) |
774 activeHelpKey: editMoveOut |
774 (MenuItem |
775 enabled: enableMovingOutHolder |
775 activeHelpKey: editMoveInAbove |
776 label: 'Move Out' |
776 enabled: enableMovingInAboveHolder |
777 itemValue: doMoveOut |
777 label: 'Move Into Previous' |
778 translateLabel: true |
778 itemValue: doMoveIn: |
779 shortcutKey: CtrlCursorLeft |
779 translateLabel: true |
780 labelImage: (ResourceRetriever Icon leftDownIcon 'Move Out' ) |
780 labelImage: (ResourceRetriever Icon upRightIcon 'Move Into Previous' ) |
781 ) |
781 argument: inPrev |
782 ) |
782 ) |
783 nil |
783 (MenuItem |
784 nil |
784 activeHelpKey: editMoveOut |
|
785 enabled: enableMovingOutHolder |
|
786 label: 'Move Out' |
|
787 itemValue: doMoveOut |
|
788 translateLabel: true |
|
789 shortcutKey: CtrlCursorLeft |
|
790 labelImage: (ResourceRetriever Icon leftDownIcon 'Move Out' ) |
|
791 ) |
|
792 ) |
|
793 nil |
|
794 nil |
785 ) |
795 ) |
786 ! |
796 ! |
787 |
797 |
788 editMenuForMainMenuWithoutAccelerators |
798 editMenuForMainMenuWithoutAccelerators |
789 "This resource specification was automatically generated |
799 "This resource specification was automatically generated |
1751 ^ BlockValue |
1761 ^ BlockValue |
1752 with:[:holder | holder size > 0] |
1762 with:[:holder | holder size > 0] |
1753 argument:(self aspectFor:#itemValue) |
1763 argument:(self aspectFor:#itemValue) |
1754 |
1764 |
1755 "Modified: / 08-03-2007 / 22:59:42 / cg" |
1765 "Modified: / 08-03-2007 / 22:59:42 / cg" |
|
1766 ! |
|
1767 |
|
1768 hasNonLinkedMenuSelectedHolder |
|
1769 "boolean holder, true if a single non linked menu item is selected |
|
1770 " |
|
1771 ^ BlockValue |
|
1772 with:[:m | |
|
1773 |items| |
|
1774 |
|
1775 items := self selectionHolder value. |
|
1776 (items size == 1) |
|
1777 and:[items first isKindOfNonLinkedMenu |
|
1778 and:[items first isRootItem not]] |
|
1779 ] |
|
1780 argument:(self selectionHolder) |
1756 ! |
1781 ! |
1757 |
1782 |
1758 hasSelectionChannel |
1783 hasSelectionChannel |
1759 "boolean holder, true if any item is selected |
1784 "boolean holder, true if any item is selected |
1760 " |
1785 " |
2423 ! |
2448 ! |
2424 |
2449 |
2425 generateMenuSpec |
2450 generateMenuSpec |
2426 "generate and returns the current menu spec or nil" |
2451 "generate and returns the current menu spec or nil" |
2427 |
2452 |
|
2453 ^ self generateMenuSpecFor:listOfItems root |
|
2454 ! |
|
2455 |
|
2456 generateMenuSpecFor:aMenuItem |
|
2457 "generate and returns a menu spec or nil" |
|
2458 |
2428 |menu| |
2459 |menu| |
2429 |
2460 |
2430 menu := listOfItems root submenu. |
2461 menu := aMenuItem submenu. |
2431 menu isNil ifTrue:[^ nil]. |
2462 menu isNil ifTrue:[^ nil]. |
2432 |
2463 |
2433 ^ menu literalArrayEncoding. |
2464 ^ menu literalArrayEncoding. |
2434 ! |
2465 ! |
2435 |
2466 |
2436 generateMenuSpecString |
2467 generateMenuSpecString |
2437 "generate and returns the current menu spec as string or nil" |
2468 "generate and returns the current menu spec as string or nil" |
2438 |
2469 |
|
2470 ^ self generateMenuSpecStringFor:listOfItems root |
|
2471 ! |
|
2472 |
|
2473 generateMenuSpecStringFor:aMenuItem |
|
2474 "generate and returns the current menu spec as string or nil" |
|
2475 |
2439 |menu specStream| |
2476 |menu specStream| |
2440 |
2477 |
2441 menu := self generateMenuSpec. |
2478 menu := self generateMenuSpecFor:aMenuItem. |
2442 menu isNil ifTrue:[^ nil]. |
2479 menu isNil ifTrue:[^ nil]. |
2443 |
2480 |
2444 specStream := WriteStream on:String new. |
2481 specStream := WriteStream on:String new. |
2445 UISpecification prettyPrintSpecArray:menu on:specStream indent:5. |
2482 UISpecification prettyPrintSpecArray:menu on:specStream indent:5. |
2446 ^ specStream contents. |
2483 ^ specStream contents. |
2708 |
2745 |
2709 "Modified: / 31-01-2011 / 18:29:06 / cg" |
2746 "Modified: / 31-01-2011 / 18:29:06 / cg" |
2710 ! ! |
2747 ! ! |
2711 |
2748 |
2712 !MenuEditor methodsFor:'user actions-building'! |
2749 !MenuEditor methodsFor:'user actions-building'! |
|
2750 |
|
2751 compileSpecMethodFor:aMenuItem selector:specSelector |
|
2752 "save current editing menu to |
|
2753 class: specClass |
|
2754 selector: specSelector |
|
2755 " |
|
2756 |cls specCode mthd category s| |
|
2757 |
|
2758 specCode := self generateMenuSpecStringFor:aMenuItem. |
|
2759 specCode isNil ifTrue:[^ nil]. |
|
2760 |
|
2761 cls := self resolveName:specClass. |
|
2762 |
|
2763 "/ if that method already exists, do not overwrite the category |
|
2764 |
|
2765 category := 'menu specs'. |
|
2766 (mthd := cls theMetaclass compiledMethodAt:specSelector) notNil ifTrue:[ |
|
2767 category := mthd category. |
|
2768 ]. |
|
2769 |
|
2770 s := '' writeStream. |
|
2771 |
|
2772 s nextPutChunkSeparator; |
|
2773 nextPutAll:(cls name); |
|
2774 nextPutAll:' class methodsFor:'; |
|
2775 nextPutAll:category storeString; |
|
2776 nextPutChunkSeparator; |
|
2777 cr; cr; |
|
2778 nextPutAll:specSelector; |
|
2779 cr; |
|
2780 nextPutAllAsChunk:(self class codeGenerationComment) withCRs; |
|
2781 cr; cr; |
|
2782 nextPutLine:' "'; |
|
2783 nextPutLine:(' MenuEditor new openOnClass:' , cls name , ' andSelector:#' , specSelector); |
|
2784 nextPutLine:(' (Menu new fromLiteralArrayEncoding:(' , cls name , ' ' , specSelector , ')) startUp'); |
|
2785 nextPutLine:' "'; |
|
2786 cr; |
|
2787 nextPutLine:' <resource: #menu>'; |
|
2788 cr; |
|
2789 nextPutAll:' ^ '; |
|
2790 nextChunkPut:specCode; |
|
2791 space; |
|
2792 nextPutChunkSeparator; |
|
2793 cr. |
|
2794 |
|
2795 Class packageQuerySignal answer:cls package do:[ |
|
2796 (ReadStream on:s contents) fileIn. |
|
2797 ]. |
|
2798 ! |
2713 |
2799 |
2714 doChooseAMenu |
2800 doChooseAMenu |
2715 "pick a menu and edit its spec method" |
2801 "pick a menu and edit its spec method" |
2716 |
2802 |
2717 |view subSpec app bldr spec menuSelector1 menuSelector2 info| |
2803 |view subSpec app bldr spec menuSelector1 menuSelector2 info| |
2794 doSave |
2880 doSave |
2795 "save current editing menu to |
2881 "save current editing menu to |
2796 class: specClass |
2882 class: specClass |
2797 selector: specSelector |
2883 selector: specSelector |
2798 " |
2884 " |
2799 |cls specCode mthd category s| |
|
2800 |
|
2801 self isEditingSpecOnly ifTrue:[ |
2885 self isEditingSpecOnly ifTrue:[ |
2802 savedSpec := self generateMenuSpec. |
2886 savedSpec := self generateMenuSpec. |
2803 hasSaved := true. |
2887 hasSaved := true. |
2804 self clearModified. |
2888 self clearModified. |
2805 ^ self |
2889 ^ self |
2806 ]. |
2890 ]. |
2807 |
2891 |
2808 super doSave ifFalse: [^nil]. |
2892 super doSave ifFalse: [^nil]. |
2809 specCode := self generateMenuSpecString. |
2893 |
2810 specCode isNil ifTrue:[^ nil]. |
2894 self compileSpecMethodFor:listOfItems root selector:specSelector. |
2811 |
|
2812 cls := self resolveName:specClass. |
|
2813 |
|
2814 "/ if that method already exists, do not overwrite the category |
|
2815 |
|
2816 category := 'menu specs'. |
|
2817 (mthd := cls class compiledMethodAt:specSelector) notNil ifTrue:[ |
|
2818 category := mthd category. |
|
2819 ]. |
|
2820 |
|
2821 s := '' writeStream. |
|
2822 |
|
2823 s nextPutChunkSeparator; |
|
2824 nextPutAll:(cls name); |
|
2825 nextPutAll:' class methodsFor:'; |
|
2826 nextPutAll:category storeString; |
|
2827 nextPutChunkSeparator; |
|
2828 cr; cr; |
|
2829 nextPutAll:specSelector; |
|
2830 cr; |
|
2831 nextPutAllAsChunk:(self class codeGenerationComment) withCRs; |
|
2832 cr; cr; |
|
2833 nextPutLine:' "'; |
|
2834 nextPutLine:(' MenuEditor new openOnClass:' , cls name , ' andSelector:#' , specSelector); |
|
2835 nextPutLine:(' (Menu new fromLiteralArrayEncoding:(' , cls name , ' ' , specSelector , ')) startUp'); |
|
2836 nextPutLine:' "'; |
|
2837 cr; |
|
2838 nextPutLine:' <resource: #menu>'; |
|
2839 cr; |
|
2840 nextPutAll:' ^ '; |
|
2841 nextChunkPut:specCode; |
|
2842 space; |
|
2843 nextPutChunkSeparator; |
|
2844 cr. |
|
2845 |
|
2846 Class packageQuerySignal answer:cls package do:[ |
|
2847 (ReadStream on:s contents) fileIn. |
|
2848 ]. |
|
2849 self isStandAlone ifTrue:[ |
2895 self isStandAlone ifTrue:[ |
2850 self helpTool doSave |
2896 self helpTool doSave |
2851 ]. |
2897 ]. |
2852 |
2898 |
2853 self updateHistory. |
2899 self updateHistory. |
3064 loMenuItems collect:[:el| Item menuItem:el ] |
3110 loMenuItems collect:[:el| Item menuItem:el ] |
3065 ]. |
3111 ]. |
3066 ! ! |
3112 ! ! |
3067 |
3113 |
3068 !MenuEditor methodsFor:'user actions-hierarchy'! |
3114 !MenuEditor methodsFor:'user actions-hierarchy'! |
|
3115 |
|
3116 doMakeLinkedMenu |
|
3117 "the selected item must be a regular submenu. |
|
3118 create a new menuspec for it, |
|
3119 and chenge the item to a linke menu item." |
|
3120 |
|
3121 |cls subSelector oldMenuItem newLinkedMenuItem index| |
|
3122 |
|
3123 oldMenuItem := self selectionHolder value first. |
|
3124 |
|
3125 subSelector := Dialog |
|
3126 request:'Name of spec method for submenu:' |
|
3127 initialAnswer:((oldMenuItem label reject:[:ch | ch isLetterOrDigit not]),'MenuSpec') asLowercaseFirst. |
|
3128 subSelector isEmptyOrNil ifTrue:[^ self]. |
|
3129 subSelector := subSelector asSymbol. |
|
3130 |
|
3131 cls := self resolveName:specClass. |
|
3132 (cls theMetaclass compiledMethodAt:subSelector) notNil ifTrue:[ |
|
3133 (Dialog confirm:'Overwrite existing spec?') ifFalse:[^ self]. |
|
3134 ]. |
|
3135 |
|
3136 self compileSpecMethodFor:oldMenuItem selector:subSelector. |
|
3137 |
|
3138 newLinkedMenuItem := LinkedMenuItem new. |
|
3139 newLinkedMenuItem submenuChannel:subSelector. |
|
3140 newLinkedMenuItem menuItem nameKey:(oldMenuItem menuItem nameKey). |
|
3141 newLinkedMenuItem menuItem label:oldMenuItem menuItem label. |
|
3142 newLinkedMenuItem menuItem rawLabel:oldMenuItem menuItem rawLabel. |
|
3143 newLinkedMenuItem menuItem translateLabel:(oldMenuItem menuItem translateLabel). |
|
3144 |
|
3145 index := oldMenuItem parent identityIndexOf:oldMenuItem. |
|
3146 oldMenuItem parent at:index put:newLinkedMenuItem. |
|
3147 |
|
3148 self selectedItem:newLinkedMenuItem. |
|
3149 ! |
3069 |
3150 |
3070 doMoveDown |
3151 doMoveDown |
3071 "move selected item down" |
3152 "move selected item down" |
3072 |
3153 |
3073 self doMoveUpOrDown:#down |
3154 self doMoveUpOrDown:#down |