1899 |
1940 |
1900 anItem notNil ifTrue:[ selection := Array with:anItem ] |
1941 anItem notNil ifTrue:[ selection := Array with:anItem ] |
1901 ifFalse:[ selection := #() ]. |
1942 ifFalse:[ selection := #() ]. |
1902 |
1943 |
1903 selectionHolder value:selection. |
1944 selectionHolder value:selection. |
|
1945 ! ! |
|
1946 |
|
1947 !MenuEditor methodsFor:'user actions - aspects'! |
|
1948 |
|
1949 collectActionSelectors |
|
1950 |selectors| |
|
1951 |
|
1952 selectors := IdentitySet new. |
|
1953 |
|
1954 listOfItems root recursiveDo:[:el| |
|
1955 el actionSelectors do:[:s| selectors add:s ]. |
|
1956 ]. |
|
1957 ^ selectors asOrderedCollection |
|
1958 ! |
|
1959 |
|
1960 collectAspectSelectors |
|
1961 |selectors| |
|
1962 |
|
1963 selectors := IdentitySet new. |
|
1964 |
|
1965 listOfItems root recursiveDo:[:el| |
|
1966 el aspectSelectors do:[:s| selectors add:s ]. |
|
1967 ]. |
|
1968 ^ selectors asOrderedCollection |
|
1969 ! |
|
1970 |
|
1971 doGenerateAspectMethods |
|
1972 "genearte aspect messages |
|
1973 " |
|
1974 |cls stream code| |
|
1975 |
|
1976 specClass ifNil:[ |
|
1977 self warn:'Define the class first !!'. |
|
1978 ^ self |
|
1979 ]. |
|
1980 |
|
1981 cls := self resolveName:specClass. |
|
1982 cls ifNil:[ |
|
1983 self warn:'Class ', specClass asString, ' does not exist!!'. |
|
1984 ^ self |
|
1985 ]. |
|
1986 stream := '' writeStream. |
|
1987 |
|
1988 self collectActionSelectors do:[:aSel| |
|
1989 code := self generateActionMethodFor:aSel inClass:cls. |
|
1990 code ifNotNil:[ stream nextPutAll:code ]. |
|
1991 ]. |
|
1992 |
|
1993 self collectAspectSelectors do:[:aSel| |
|
1994 code := self generateAspectMethodFor:aSel inClass:cls. |
|
1995 code ifNotNil:[ stream nextPutAll:code ]. |
|
1996 ]. |
|
1997 |
|
1998 code := stream contents. |
|
1999 |
|
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 |
1904 ! ! |
2150 ! ! |
1905 |
2151 |
1906 !MenuEditor methodsFor:'user actions - building'! |
2152 !MenuEditor methodsFor:'user actions - building'! |
1907 |
2153 |
1908 doNew |
2154 doNew |