1610 self valueOfEnableMovingInAbove value:(selectedItem canMoveInAbove). |
1626 self valueOfEnableMovingInAbove value:(selectedItem canMoveInAbove). |
1611 self canCreateDelayedMenuChannel value:(selectedItem canAddDelayedMenu). |
1627 self canCreateDelayedMenuChannel value:(selectedItem canAddDelayedMenu). |
1612 ]. |
1628 ]. |
1613 ! ! |
1629 ! ! |
1614 |
1630 |
|
1631 !MenuEditor methodsFor:'code generation'! |
|
1632 |
|
1633 createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine |
|
1634 |alreadyInSuperclass numArgs method code| |
|
1635 |
|
1636 (aClass includesSelector:aSelector) ifTrue:[ |
|
1637 ^ nil |
|
1638 ]. |
|
1639 |
|
1640 alreadyInSuperclass := aClass superclass canUnderstand:aSelector. |
|
1641 |
|
1642 (alreadyInSuperclass and:[redefine not]) ifTrue:[ |
|
1643 ^ nil |
|
1644 ]. |
|
1645 |
|
1646 numArgs := aSelector numArgs. |
|
1647 |
|
1648 numArgs == 1 ifTrue:[ |
|
1649 method := aSelector, 'anArgument'. |
|
1650 ] ifFalse:[ |
|
1651 numArgs == 0 ifTrue:[ |
|
1652 method := aSelector |
|
1653 ] ifFalse:[ |
|
1654 method := ''. |
|
1655 aSelector keywords keysAndValuesDo:[:i :key| |
|
1656 method := method, key, 'arg', i printString, ' '. |
|
1657 ]. |
|
1658 ] |
|
1659 ]. |
|
1660 |
|
1661 code := '%1 |
|
1662 "automatically generated by UIEditor ..." |
|
1663 |
|
1664 "*** the code below performs no action" |
|
1665 "*** (except for some feedback on the Transcript)" |
|
1666 "*** Please change as required and accept in the browser." |
|
1667 "*** (and replace this comment by something more useful ;-)" |
|
1668 |
|
1669 "action to be added ..." |
|
1670 |
|
1671 Transcript showCR:self class name, '': action for #%2 ...''. |
|
1672 ' bindWith:method with:aSelector. |
|
1673 |
|
1674 alreadyInSuperclass ifTrue:[ |
|
1675 code := code, (('\ super %1\' bindWith:method) withCRs). |
|
1676 ]. |
|
1677 CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions'). |
|
1678 ^ code |
|
1679 ! |
|
1680 |
|
1681 createAspectMethodFor:anAspect in:aClass category:aCategory redefine:redefine |
|
1682 |alreadyInSuperclass numArgs method code text| |
|
1683 |
|
1684 (aClass includesSelector:anAspect) ifTrue:[ |
|
1685 ^ nil |
|
1686 ]. |
|
1687 |
|
1688 alreadyInSuperclass := aClass superclass canUnderstand:anAspect. |
|
1689 |
|
1690 (alreadyInSuperclass and:[redefine not]) ifTrue:[ |
|
1691 ^ nil |
|
1692 ]. |
|
1693 |
|
1694 numArgs := anAspect numArgs. |
|
1695 |
|
1696 numArgs == 1 ifTrue:[ |
|
1697 method := anAspect, 'anArgument'. |
|
1698 ] ifFalse:[ |
|
1699 numArgs == 0 ifTrue:[ |
|
1700 method := anAspect |
|
1701 ] ifFalse:[ |
|
1702 method := ''. |
|
1703 anAspect keywords keysAndValuesDo:[:i :key| |
|
1704 method := method, key, 'arg', i printString, ' '. |
|
1705 ]. |
|
1706 ] |
|
1707 ]. |
|
1708 |
|
1709 code := '%1 |
|
1710 "automatically generated by UIEditor ..." |
|
1711 |
|
1712 "*** the code below creates a default model when invoked" |
|
1713 "*** (which may not be the one you wanted)" |
|
1714 "*** Please change as required and accept in the browser." |
|
1715 "*** (and replace this comment by something more useful ;-)" |
|
1716 |
|
1717 "aspect to be added ..." |
|
1718 |
|
1719 Transcript showCR:self class name, '': aspect for #%2 ...''. |
|
1720 |
|
1721 ' bindWith:method with:anAspect. |
|
1722 |
|
1723 alreadyInSuperclass ifTrue:[ |
|
1724 text := ' ^ super %1\' bindWith:method. |
|
1725 ] ifFalse:[ |
|
1726 text := ' ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:anAspect. |
|
1727 ]. |
|
1728 code := code, (text withCRs). |
|
1729 CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions'). |
|
1730 ^ code |
|
1731 ! ! |
|
1732 |
1615 !MenuEditor methodsFor:'defaults'! |
1733 !MenuEditor methodsFor:'defaults'! |
1616 |
1734 |
1617 aboutImage |
1735 aboutImage |
1618 "the image to be displayed in my about-box; |
1736 "the image to be displayed in my about-box; |
1619 If nil is returned, the ST/X default image is used. |
1737 If nil is returned, the ST/X default image is used. |
1969 ! |
2086 ! |
1970 |
2087 |
1971 doGenerateAspectMethods |
2088 doGenerateAspectMethods |
1972 "genearte aspect messages |
2089 "genearte aspect messages |
1973 " |
2090 " |
1974 |cls stream code| |
2091 |cls redefineAspectMethods| |
1975 |
2092 |
1976 specClass ifNil:[ |
2093 specClass ifNil:[ |
1977 self warn:'Define the class first !!'. |
2094 self warn:'Define the class first !!'. |
1978 ^ self |
2095 ^ self |
1979 ]. |
2096 ]. |
|
2097 redefineAspectMethods := self redefineAspectMethodsChannel value. |
1980 |
2098 |
1981 cls := self resolveName:specClass. |
2099 cls := self resolveName:specClass. |
1982 cls ifNil:[ |
2100 cls ifNil:[ |
1983 self warn:'Class ', specClass asString, ' does not exist!!'. |
2101 self warn:'Class ', specClass asString, ' does not exist!!'. |
1984 ^ self |
2102 ^ self |
1985 ]. |
2103 ]. |
1986 stream := '' writeStream. |
2104 |
1987 |
2105 self collectActionSelectors do:[:aSelector| |
1988 self collectActionSelectors do:[:aSel| |
2106 self createActionMethodFor:aSelector |
1989 code := self generateActionMethodFor:aSel inClass:cls. |
2107 in:cls |
1990 code ifNotNil:[ stream nextPutAll:code ]. |
2108 category:'menu - actions' |
1991 ]. |
2109 redefine:redefineAspectMethods. |
1992 |
2110 ]. |
1993 self collectAspectSelectors do:[:aSel| |
2111 |
1994 code := self generateAspectMethodFor:aSel inClass:cls. |
2112 self collectAspectSelectors do:[:anAspect| |
1995 code ifNotNil:[ stream nextPutAll:code ]. |
2113 self createAspectMethodFor:anAspect |
1996 ]. |
2114 in:cls |
1997 |
2115 category:'menu - aspects' |
1998 code := stream contents. |
2116 redefine:redefineAspectMethods |
1999 |
2117 ]. |
2000 code size ~~ 0 ifTrue:[ |
|
2001 code readStream fileIn |
|
2002 ]. |
|
2003 ! |
|
2004 |
|
2005 generateActionMethodFor:selector inClass:targetClass |
|
2006 "genearte aspect messages |
|
2007 " |
|
2008 | alreadyInSuperclass numArgs method args showIt code| |
|
2009 |
|
2010 (targetClass includesSelector:selector) ifTrue:[ |
|
2011 "/ Transcript showCR:'#' , selector , ' skipped - already implemented in the class'. |
|
2012 ^ nil |
|
2013 ]. |
|
2014 |
|
2015 alreadyInSuperclass := targetClass superclass canUnderstand:selector. |
|
2016 |
|
2017 alreadyInSuperclass ifTrue:[ |
|
2018 redefineAspectMethods ifFalse:[ |
|
2019 "/ Transcript showCR:'#' , selector , ' skipped - already implemented in superclass'. |
|
2020 ^ nil |
|
2021 ] |
|
2022 ]. |
|
2023 |
|
2024 numArgs := selector numArgs. |
|
2025 method := selector. |
|
2026 |
|
2027 numArgs == 1 ifTrue:[ |
|
2028 args := 'anArgument'. |
|
2029 showIt := ''' , anArgument printString , '' ...''.\'. |
|
2030 ] ifFalse:[ |
|
2031 args := ''. |
|
2032 showIt := ' ...''.\'. |
|
2033 |
|
2034 numArgs ~~ 0 ifTrue:[ |
|
2035 method := ''. |
|
2036 |
|
2037 selector keywords keysAndValuesDo:[:i :key| |
|
2038 method := method, key, 'arg', i printString, ' ' |
|
2039 ] |
|
2040 ] |
|
2041 ]. |
|
2042 code := '!!' , targetClass name , ' methodsFor:''menu actions''!!\\' , |
|
2043 method , args , '\' , |
|
2044 ' "automatically generated by MenuEditor ..."\\' , |
|
2045 ' "*** the code below performs no action"\' , |
|
2046 ' "*** (except for some feedback on the Transcript)"\' , |
|
2047 ' "*** Please change as required and accept in the browser."\' , |
|
2048 ' "*** (and replace this comment by something more useful ;-)"\' , |
|
2049 '\' . |
|
2050 |
|
2051 alreadyInSuperclass ifTrue:[ |
|
2052 code := code , |
|
2053 ' "action for ' , selector , ' is already provided in a superclass."\' , |
|
2054 ' "It may be redefined here ..."\\'. |
|
2055 ] ifFalse:[ |
|
2056 code := code , |
|
2057 ' "action to be added ..."\\'. |
|
2058 ]. |
|
2059 |
|
2060 code := code , |
|
2061 ' Transcript showCR:self class name, '': '. |
|
2062 alreadyInSuperclass ifTrue:[ |
|
2063 code := code , 'inherited '. |
|
2064 ]. |
|
2065 code := code , 'action for ' , selector , showIt. |
|
2066 |
|
2067 alreadyInSuperclass ifTrue:[ |
|
2068 code := code , |
|
2069 ' super ' , selector , args , '.\'. |
|
2070 ]. |
|
2071 |
|
2072 code := code , |
|
2073 '!! !!\\'. |
|
2074 ^ code withCRs |
|
2075 ! |
|
2076 |
|
2077 generateAspectMethodFor:aspect inClass:targetClass |
|
2078 "genearte aspect messages |
|
2079 " |
|
2080 | alreadyInSuperclass numArgs method args showIt code| |
|
2081 |
|
2082 (targetClass includesSelector:aspect) ifTrue:[ |
|
2083 "/ Transcript showCR:'#' , aspect , ' skipped - already implemented in the class'. |
|
2084 ^ nil |
|
2085 ]. |
|
2086 |
|
2087 alreadyInSuperclass := targetClass superclass canUnderstand:aspect. |
|
2088 |
|
2089 alreadyInSuperclass ifTrue:[ |
|
2090 redefineAspectMethods ifFalse:[ |
|
2091 "/ Transcript showCR:'#' , aspect , ' skipped - already implemented in superclass'. |
|
2092 ^ nil |
|
2093 ] |
|
2094 ]. |
|
2095 |
|
2096 numArgs := aspect numArgs. |
|
2097 method := aspect. |
|
2098 |
|
2099 numArgs == 1 ifTrue:[ |
|
2100 args := 'anArgument'. |
|
2101 showIt := ''' , anArgument printString , '' ...''.\'. |
|
2102 ] ifFalse:[ |
|
2103 args := ''. |
|
2104 showIt := ' ...''.\'. |
|
2105 |
|
2106 numArgs ~~ 0 ifTrue:[ |
|
2107 method := ''. |
|
2108 |
|
2109 aspect keywords keysAndValuesDo:[:i :key| |
|
2110 method := method, key, 'arg', i printString, ' ' |
|
2111 ] |
|
2112 ] |
|
2113 ]. |
|
2114 code := '!!' , targetClass name , ' methodsFor:''menu aspect''!!\\' , |
|
2115 method , args , '\' , |
|
2116 ' "automatically generated by MenuEditor ..."\\' , |
|
2117 ' "*** the code below creates a default model when invoked"\' , |
|
2118 ' "*** (which may not be the one you wanted)"\' , |
|
2119 ' "*** Please change as required and accept in the browser."\' , |
|
2120 ' "*** (and replace this comment by something more useful ;-)"\' , |
|
2121 '\' . |
|
2122 |
|
2123 alreadyInSuperclass ifTrue:[ |
|
2124 code := code , |
|
2125 ' "aspect for ' , aspect , ' is already provided in a superclass."\' , |
|
2126 ' "It may be redefined here ..."\\'. |
|
2127 ] ifFalse:[ |
|
2128 code := code , |
|
2129 ' "aspect to be added ..."\\'. |
|
2130 ]. |
|
2131 |
|
2132 code := code , |
|
2133 ' Transcript showCR:self class name, '': '. |
|
2134 alreadyInSuperclass ifTrue:[ |
|
2135 code := code , 'inherited '. |
|
2136 ]. |
|
2137 code := code , 'aspect for ' , aspect , showIt, '\'. |
|
2138 |
|
2139 alreadyInSuperclass ifTrue:[ |
|
2140 code := code , |
|
2141 ' ^ super ' , aspect , args , '.\'. |
|
2142 ] ifFalse:[ |
|
2143 code := code , |
|
2144 ' ^ builder valueAspectFor:#' , aspect , ' initialValue:true.\'. |
|
2145 ]. |
|
2146 |
|
2147 code := code , |
|
2148 '!! !!\\'. |
|
2149 ^ code withCRs |
|
2150 ! ! |
2118 ! ! |
2151 |
2119 |
2152 !MenuEditor methodsFor:'user actions - building'! |
2120 !MenuEditor methodsFor:'user actions - building'! |
2153 |
2121 |
2154 doNew |
2122 doNew |