--- a/MenuEditor.st Wed Oct 02 15:13:42 2002 +0200
+++ b/MenuEditor.st Wed Oct 02 18:38:10 2002 +0200
@@ -14,8 +14,7 @@
ResourceSpecEditor subclass:#MenuEditor
instanceVariableNames:'selectionHolder tabHolder listOfItems listOfTabs
- selectedSuperItems notifyDisabledCounter wizards listOfItemsView
- redefineAspectMethods'
+ selectedSuperItems notifyDisabledCounter wizards listOfItemsView'
classVariableNames:'ImageRetrieverClasses'
poolDictionaries:''
category:'Interface-UIPainter'
@@ -378,6 +377,9 @@
#showBusyCursorWhilePerforming
'If on, a busy cursor is shown while the items action is performing.'
+#settingsRedefineAspectMethods
+'Toggles the permission to overwrite existing aspect methods.'
+
#triggerOnDown
'If on, the items action is performed on mouse-button press (default is on button-release).'
@@ -786,6 +788,13 @@
#(#Menu
#(
#(#MenuItem
+ #label: 'Redefine Aspect Methods'
+ #hideMenuOnActivated: false
+ #activeHelpKey: #settingsRedefineAspectMethods
+ #enabled: #hasValidSpecClass
+ #indication: #redefineAspectMethodsChannel
+ )
+ #(#MenuItem
#label: 'Aspect Methods'
#value: #doGenerateAspectMethods
#activeHelpKey: #generateAspectMethods
@@ -1405,6 +1414,13 @@
^ listOfTabs
!
+redefineAspectMethodsChannel
+ "boolean holder, true if aspects should be generated in only implemented
+ in superClass by calling #super ...
+ "
+ ^ builder booleanValueAspectFor:#redefineAspectMethodsChannel
+!
+
selectionHolder
"value holder, which keeps the current selected items
"
@@ -1612,6 +1628,108 @@
].
! !
+!MenuEditor methodsFor:'code generation'!
+
+createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine
+ |alreadyInSuperclass numArgs method code|
+
+ (aClass includesSelector:aSelector) ifTrue:[
+ ^ nil
+ ].
+
+ alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
+
+ (alreadyInSuperclass and:[redefine not]) ifTrue:[
+ ^ nil
+ ].
+
+ numArgs := aSelector numArgs.
+
+ numArgs == 1 ifTrue:[
+ method := aSelector, 'anArgument'.
+ ] ifFalse:[
+ numArgs == 0 ifTrue:[
+ method := aSelector
+ ] ifFalse:[
+ method := ''.
+ aSelector keywords keysAndValuesDo:[:i :key|
+ method := method, key, 'arg', i printString, ' '.
+ ].
+ ]
+ ].
+
+ code := '%1
+ "automatically generated by UIEditor ..."
+
+ "*** the code below performs no action"
+ "*** (except for some feedback on the Transcript)"
+ "*** Please change as required and accept in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+ "action to be added ..."
+
+ Transcript showCR:self class name, '': action for #%2 ...''.
+' bindWith:method with:aSelector.
+
+ alreadyInSuperclass ifTrue:[
+ code := code, (('\ super %1\' bindWith:method) withCRs).
+ ].
+ CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions').
+ ^ code
+!
+
+createAspectMethodFor:anAspect in:aClass category:aCategory redefine:redefine
+ |alreadyInSuperclass numArgs method code text|
+
+ (aClass includesSelector:anAspect) ifTrue:[
+ ^ nil
+ ].
+
+ alreadyInSuperclass := aClass superclass canUnderstand:anAspect.
+
+ (alreadyInSuperclass and:[redefine not]) ifTrue:[
+ ^ nil
+ ].
+
+ numArgs := anAspect numArgs.
+
+ numArgs == 1 ifTrue:[
+ method := anAspect, 'anArgument'.
+ ] ifFalse:[
+ numArgs == 0 ifTrue:[
+ method := anAspect
+ ] ifFalse:[
+ method := ''.
+ anAspect keywords keysAndValuesDo:[:i :key|
+ method := method, key, 'arg', i printString, ' '.
+ ].
+ ]
+ ].
+
+ code := '%1
+ "automatically generated by UIEditor ..."
+
+ "*** the code below creates a default model when invoked"
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+ "aspect to be added ..."
+
+ Transcript showCR:self class name, '': aspect for #%2 ...''.
+
+' bindWith:method with:anAspect.
+
+ alreadyInSuperclass ifTrue:[
+ text := ' ^ super %1\' bindWith:method.
+ ] ifFalse:[
+ text := ' ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:anAspect.
+ ].
+ code := code, (text withCRs).
+ CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions').
+ ^ code
+! !
+
!MenuEditor methodsFor:'defaults'!
aboutImage
@@ -1725,7 +1843,6 @@
"
super initialize.
notifyDisabledCounter := 0.
- redefineAspectMethods := true.
Item withAllSubclasses do:[:aClass|
aClass addBindingsTo:aspects for:self.
@@ -1971,182 +2088,33 @@
doGenerateAspectMethods
"genearte aspect messages
"
- |cls stream code|
+ |cls redefineAspectMethods|
specClass ifNil:[
self warn:'Define the class first !!'.
^ self
].
+ redefineAspectMethods := self redefineAspectMethodsChannel value.
cls := self resolveName:specClass.
cls ifNil:[
self warn:'Class ', specClass asString, ' does not exist!!'.
^ self
].
- stream := '' writeStream.
-
- self collectActionSelectors do:[:aSel|
- code := self generateActionMethodFor:aSel inClass:cls.
- code ifNotNil:[ stream nextPutAll:code ].
- ].
-
- self collectAspectSelectors do:[:aSel|
- code := self generateAspectMethodFor:aSel inClass:cls.
- code ifNotNil:[ stream nextPutAll:code ].
- ].
-
- code := stream contents.
-
- code size ~~ 0 ifTrue:[
- code readStream fileIn
- ].
-!
-
-generateActionMethodFor:selector inClass:targetClass
- "genearte aspect messages
- "
- | alreadyInSuperclass numArgs method args showIt code|
-
- (targetClass includesSelector:selector) ifTrue:[
- "/ Transcript showCR:'#' , selector , ' skipped - already implemented in the class'.
- ^ nil
- ].
-
- alreadyInSuperclass := targetClass superclass canUnderstand:selector.
-
- alreadyInSuperclass ifTrue:[
- redefineAspectMethods ifFalse:[
- "/ Transcript showCR:'#' , selector , ' skipped - already implemented in superclass'.
- ^ nil
- ]
- ].
-
- numArgs := selector numArgs.
- method := selector.
-
- numArgs == 1 ifTrue:[
- args := 'anArgument'.
- showIt := ''' , anArgument printString , '' ...''.\'.
- ] ifFalse:[
- args := ''.
- showIt := ' ...''.\'.
-
- numArgs ~~ 0 ifTrue:[
- method := ''.
-
- selector keywords keysAndValuesDo:[:i :key|
- method := method, key, 'arg', i printString, ' '
- ]
- ]
- ].
- code := '!!' , targetClass name , ' methodsFor:''menu actions''!!\\' ,
- method , args , '\' ,
- ' "automatically generated by MenuEditor ..."\\' ,
- ' "*** the code below performs no action"\' ,
- ' "*** (except for some feedback on the Transcript)"\' ,
- ' "*** Please change as required and accept in the browser."\' ,
- ' "*** (and replace this comment by something more useful ;-)"\' ,
- '\' .
-
- alreadyInSuperclass ifTrue:[
- code := code ,
- ' "action for ' , selector , ' is already provided in a superclass."\' ,
- ' "It may be redefined here ..."\\'.
- ] ifFalse:[
- code := code ,
- ' "action to be added ..."\\'.
- ].
-
- code := code ,
- ' Transcript showCR:self class name, '': '.
- alreadyInSuperclass ifTrue:[
- code := code , 'inherited '.
+
+ self collectActionSelectors do:[:aSelector|
+ self createActionMethodFor:aSelector
+ in:cls
+ category:'menu - actions'
+ redefine:redefineAspectMethods.
].
- code := code , 'action for ' , selector , showIt.
-
- alreadyInSuperclass ifTrue:[
- code := code ,
- ' super ' , selector , args , '.\'.
- ].
-
- code := code ,
- '!! !!\\'.
- ^ code withCRs
-!
-
-generateAspectMethodFor:aspect inClass:targetClass
- "genearte aspect messages
- "
- | alreadyInSuperclass numArgs method args showIt code|
-
- (targetClass includesSelector:aspect) ifTrue:[
- "/ Transcript showCR:'#' , aspect , ' skipped - already implemented in the class'.
- ^ nil
- ].
-
- alreadyInSuperclass := targetClass superclass canUnderstand:aspect.
-
- alreadyInSuperclass ifTrue:[
- redefineAspectMethods ifFalse:[
- "/ Transcript showCR:'#' , aspect , ' skipped - already implemented in superclass'.
- ^ nil
- ]
+
+ self collectAspectSelectors do:[:anAspect|
+ self createAspectMethodFor:anAspect
+ in:cls
+ category:'menu - aspects'
+ redefine:redefineAspectMethods
].
-
- numArgs := aspect numArgs.
- method := aspect.
-
- numArgs == 1 ifTrue:[
- args := 'anArgument'.
- showIt := ''' , anArgument printString , '' ...''.\'.
- ] ifFalse:[
- args := ''.
- showIt := ' ...''.\'.
-
- numArgs ~~ 0 ifTrue:[
- method := ''.
-
- aspect keywords keysAndValuesDo:[:i :key|
- method := method, key, 'arg', i printString, ' '
- ]
- ]
- ].
- code := '!!' , targetClass name , ' methodsFor:''menu aspect''!!\\' ,
- method , args , '\' ,
- ' "automatically generated by MenuEditor ..."\\' ,
- ' "*** the code below creates a default model when invoked"\' ,
- ' "*** (which may not be the one you wanted)"\' ,
- ' "*** Please change as required and accept in the browser."\' ,
- ' "*** (and replace this comment by something more useful ;-)"\' ,
- '\' .
-
- alreadyInSuperclass ifTrue:[
- code := code ,
- ' "aspect for ' , aspect , ' is already provided in a superclass."\' ,
- ' "It may be redefined here ..."\\'.
- ] ifFalse:[
- code := code ,
- ' "aspect to be added ..."\\'.
- ].
-
- code := code ,
- ' Transcript showCR:self class name, '': '.
- alreadyInSuperclass ifTrue:[
- code := code , 'inherited '.
- ].
- code := code , 'aspect for ' , aspect , showIt, '\'.
-
- alreadyInSuperclass ifTrue:[
- code := code ,
- ' ^ super ' , aspect , args , '.\'.
- ] ifFalse:[
- code := code ,
- ' ^ builder valueAspectFor:#' , aspect , ' initialValue:true.\'.
- ].
-
- code := code ,
- '!! !!\\'.
- ^ code withCRs
! !
!MenuEditor methodsFor:'user actions - building'!