--- a/UIPainterView.st Fri Aug 21 21:00:30 1998 +0200
+++ b/UIPainterView.st Mon Aug 24 12:56:23 1998 +0200
@@ -893,6 +893,190 @@
"Created: / 31.10.1997 / 17:32:49 / cg"
!
+generateMenuMethodFor:menuSel inClass:targetClass
+ |selector args showIt code alreadyInSuperclass numArgs method|
+
+ selector := menuSel asSymbol.
+
+ alreadyInSuperclass := targetClass superclass canUnderstand:selector.
+
+ code := '!!' , targetClass name , ' methodsFor:''menu actions''!!\\'.
+
+ selector = 'openAboutThisApplication' ifTrue:[
+ code := code ,
+ 'openAboutThisApplication\' ,
+ ' "opens an about box for this application."\\' ,
+ ' "automatically generated by UIPainter ..."\\' ,
+
+ ' |rev box myClass clsRev image msg|\\' ,
+
+ ' rev := ''''.\' ,
+ ' myClass := self class.\' ,
+
+ ' (clsRev := myClass revision) notNil ifTrue:[\' ,
+ ' rev := '' (rev: '', clsRev printString, '')''].\\' ,
+
+ ' msg := Character cr asString , myClass name asBoldText, rev.\' ,
+ ' msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' ,
+ ' box := AboutBox title:msg.\' ,
+
+ ' "/ *** add a #defaultIcon method in the class\' ,
+ ' "/ *** and uncomment the following line:\' ,
+ ' "/ image := self class defaultIcon.\\' ,
+ ' image notNil ifTrue:[\' ,
+ ' box image:image\' ,
+ ' ].\' ,
+ ' box label:(resources string:''About %1'' with:myClass name).\' ,
+ ' box autoHideAfter:10 with:[].\' ,
+ ' box showAtPointer.\' ,
+ '!! !!\\'.
+ ^ code withCRs
+ ].
+
+ selector = 'menuOpen' ifTrue:[
+ code := code ,
+ 'menuOpen\' ,
+ ' "automatically generated by UIPainter ..."\\' ,
+ ' "*** the code below opens a dialog for file selection"\' ,
+ ' "*** and invokes the #doOpen: method with the selected file."\' ,
+ ' "*** Please change as required and accept in the browser."\\' ,
+ ' |file|\\' ,
+ ' file :=\' ,
+ ' (FileSelectionBrowser\' ,
+ ' request: ''Open''\' ,
+ ' fileName: ''''\' ,
+ ' "/ inDirectory: lastOpenDirectory\' ,
+ ' withFileFilters: #(''*'')).\\' ,
+ ' file notNil ifTrue:[\' ,
+ ' "/ lastOpenDirectory := file asFilename directory.\' ,
+ ' self doOpen:file\' ,
+ ' ]\' ,
+ '!! !!\'.
+ ^ code withCRs
+ ].
+
+ 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 := code ,
+ method , args , '\' ,
+ ' "automatically generated by UIPainter ..."\\' ,
+ ' "*** the code below performs no action"\' ,
+ ' "*** (except for some feedback on the Transcript)"\' ,
+ ' "*** Please change as required and accept in the browser."\' ,
+ '\' .
+
+ 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 , 'menu action for ' , selector , showIt.
+
+ alreadyInSuperclass ifTrue:[
+ code := code ,
+ ' super ' , selector , args , '.\'.
+ ].
+
+ code := code ,
+ '!! !!\\'.
+ ^ code withCRs
+
+ "Created: / 23.8.1998 / 16:46:51 / cg"
+ "Modified: / 23.8.1998 / 18:13:05 / cg"
+!
+
+generateMenuMethods
+ "generate menu methods
+ - but do not overwrite existing ones.
+ Return a string ready to compile into the application class."
+
+ |cls code skip menuSelector protoSpec thisCode
+ definedMethodSelectors iVars t
+ specArray fullSpec winSpec menuSpec
+ |
+
+ className isNil ifTrue:[
+ self warn:'Set first the class!!'.
+ ^ code
+ ].
+
+ (cls := self resolveName:className) isNil ifTrue:[
+ self warn:'Class ', className asString, ' does not exist!!'.
+ ^ code
+ ].
+
+ specArray := treeView generateFullSpecForComponents:#().
+ fullSpec := specArray decodeAsLiteralArray.
+ winSpec := fullSpec window.
+ menuSelector := winSpec menu.
+
+ menuSelector isNil ifTrue:[
+ self warn:'No menu defined (yet)'.
+ ^ code
+ ].
+ (cls respondsTo:menuSelector) ifFalse:[
+ self warn:'No menu defined (yet)'.
+ ^ code.
+ ].
+ menuSpec := cls perform:menuSelector.
+ menuSpec := menuSpec decodeAsLiteralArray.
+
+ definedMethodSelectors := IdentitySet new.
+ code := ''.
+
+ menuSpec allItemsDo:[:item |
+ |sel|
+
+ (sel := item value) notNil ifTrue:[
+ (definedMethodSelectors includes:sel) ifFalse:[
+ self generateCodeFrom:(Array with:sel) in:cls do:[:aSel|
+ thisCode := (self generateMenuMethodFor:aSel inClass:cls).
+ code := code, thisCode.
+ ].
+ definedMethodSelectors add:sel.
+ ].
+ ]
+ ].
+
+ (definedMethodSelectors includes:#menuOpen) ifTrue:[
+ self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel|
+ thisCode := (self generateMenuMethodFor:aSel inClass:cls).
+ code := code, thisCode.
+ ].
+ ].
+
+ ^ code
+
+ "Created: / 23.8.1998 / 16:12:09 / cg"
+ "Modified: / 23.8.1998 / 18:12:23 / cg"
+!
+
generateValueMethodFor:aspect spec:protoSpec inClass:targetClass
^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' ,
aspect , '\' ,