# HG changeset patch # User ca # Date 1033562689 -7200 # Node ID 46cc531eecc6a69f6dd9e902731abd6d590d380c # Parent 1d4f11252d3b178dfcbed4727c49a280a162ef09 add code generation diff -r 1d4f11252d3b -r 46cc531eecc6 MenuEditor.st --- a/MenuEditor.st Wed Oct 02 10:36:18 2002 +0200 +++ b/MenuEditor.st Wed Oct 02 14:44:49 2002 +0200 @@ -14,7 +14,8 @@ ResourceSpecEditor subclass:#MenuEditor instanceVariableNames:'selectionHolder tabHolder listOfItems listOfTabs - selectedSuperItems notifyDisabledCounter wizards listOfItemsView' + selectedSuperItems notifyDisabledCounter wizards listOfItemsView + redefineAspectMethods' classVariableNames:'ImageRetrieverClasses' poolDictionaries:'' category:'Interface-UIPainter' @@ -347,6 +348,9 @@ #fileShowMenuSpec 'Opens a Workspace showing the current menu spec.' +#generateAspectMethods +'Generates aspect methods for defined aspect selectors of the menu.' + #hideMenuOnActivated 'If on, the menu hides itself after the item was activated.' @@ -764,6 +768,35 @@ ) ! +generateMenu + "This resource specification was automatically generated + by the MenuEditor of ST/X." + + "Do not manually edit this!! If it is corrupted, + the MenuEditor may not be able to read the specification." + + " + MenuEditor new openOnClass:MenuEditor andSelector:#generateMenu + (Menu new fromLiteralArrayEncoding:(MenuEditor generateMenu)) startUp + " + + + + ^ + #(#Menu + #( + #(#MenuItem + #label: 'Aspect Methods' + #value: #doGenerateAspectMethods + #activeHelpKey: #generateAspectMethods + #enabled: #hasValidSpecClass + ) + ) + nil + nil + ) +! + helpMenu "This resource specification was automatically generated by the MenuEditor of ST/X." @@ -874,6 +907,13 @@ #submenuChannel: #menuHistory ) #(#MenuItem + #label: 'Generate' + #translateLabel: true + #activeHelpKey: #generate + #submenuChannel: #generateMenu + #keepLinkedMenu: true + ) + #(#MenuItem #label: '&Help' #translateLabel: true #startGroup: #right @@ -1685,6 +1725,7 @@ " super initialize. notifyDisabledCounter := 0. + redefineAspectMethods := true. Item withAllSubclasses do:[:aClass| aClass addBindingsTo:aspects for:self. @@ -1903,6 +1944,211 @@ selectionHolder value:selection. ! ! +!MenuEditor methodsFor:'user actions - aspects'! + +collectActionSelectors + |selectors| + + selectors := IdentitySet new. + + listOfItems root recursiveDo:[:el| + el actionSelectors do:[:s| selectors add:s ]. + ]. + ^ selectors asOrderedCollection +! + +collectAspectSelectors + |selectors| + + selectors := IdentitySet new. + + listOfItems root recursiveDo:[:el| + el aspectSelectors do:[:s| selectors add:s ]. + ]. + ^ selectors asOrderedCollection +! + +doGenerateAspectMethods + "genearte aspect messages + " + |cls stream code| + + specClass ifNil:[ + self warn:'Define the class first !!'. + ^ self + ]. + + 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 '. + ]. + 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 + ] + ]. + + 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'! doNew @@ -2799,6 +3045,32 @@ ^ false ! ! +!MenuEditor::Item methodsFor:'queries - editor'! + +actionSelectors + "returns my action selectors + " + |value| + + value := menuItem value. + value isSymbol ifTrue:[ ^ Array with:value ]. + ^ #() +! + +aspectSelectors + "returns my aspect selectors + " + |aspects| + + aspects := OrderedCollection new. + + #( indication choice enabled isVisible ) do:[:aKey| |sel| + sel := menuItem perform:aKey. + sel isSymbol ifTrue:[ aspects add:sel ] + ]. + ^ aspects +! ! + !MenuEditor::Item methodsFor:'queries - operation'! canAddChildren @@ -3955,6 +4227,20 @@ ^ true ! ! +!MenuEditor::ItemRoot methodsFor:'queries - editor'! + +actionSelectors + "returns my action selectors + " + ^ #() +! + +aspectSelectors + "returns my aspect selectors + " + ^ #() +! ! + !MenuEditor::ItemRoot methodsFor:'queries - operation'! canMoveInAbove