--- 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
+ "
+
+ <resource: #menu>
+
+ ^
+ #(#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