2428 |
2428 |
2429 helpTool := UIHelpTool new. |
2429 helpTool := UIHelpTool new. |
2430 applBuilder := helpTool builder. |
2430 applBuilder := helpTool builder. |
2431 applWindow := ApplicationSubView origin:0.0@0.0 corner:1.0@1.0 in:noteBook. |
2431 applWindow := ApplicationSubView origin:0.0@0.0 corner:1.0@1.0 in:noteBook. |
2432 applWindow level:0. |
2432 applWindow level:0. |
2433 helpTool buildFromClass:specClass. |
2433 helpTool loadFromClass:specClass. |
2434 helpTool masterApplication:self. |
2434 helpTool masterApplication:self. |
2435 applBuilder window:applWindow. |
2435 applBuilder window:applWindow. |
2436 applWindow client:helpTool spec:#windowSpec builder:applBuilder. |
2436 applWindow client:helpTool spec:#windowSpec builder:applBuilder. |
2437 applBuilder window:applWindow. |
2437 applBuilder window:applWindow. |
2438 helpTool modifiedHolder:modifiedChannel. |
2438 helpTool modifiedHolder:modifiedChannel. |
3038 specClass isNil ifTrue:[^ false]. |
3038 specClass isNil ifTrue:[^ false]. |
3039 |
3039 |
3040 cls := self resolveName:specClass. |
3040 cls := self resolveName:specClass. |
3041 |
3041 |
3042 cls isNil ifTrue:[ |
3042 cls isNil ifTrue:[ |
3043 superclass := self resolveName:specSuperclass. |
3043 superclass := self resolveName:specSuperclassName. |
3044 |
3044 |
3045 superclass isNil ifTrue:[ |
3045 superclass isNil ifTrue:[ |
3046 self warn:'No class named ' , specSuperclass , ' exists!!'. |
3046 self warn:'No class named ' , specSuperclassName , ' exists!!'. |
3047 ^ false. |
3047 ^ false. |
3048 ]. |
3048 ]. |
3049 |
3049 |
3050 (self confirm:'Create class ' , specClass asBoldText, '?') ifTrue:[ |
3050 (self confirm:'Create class ' , specClass asBoldText, '?') ifTrue:[ |
3051 cls := superclass |
3051 cls := superclass |
3052 subclass:(specClass asSymbol) |
3052 subclass:(specClass asSymbol) |
3053 instanceVariableNames:'' |
3053 instanceVariableNames:'' |
3054 classVariableNames:'' |
3054 classVariableNames:'' |
3055 poolDictionaries:'' |
3055 poolDictionaries:'' |
3056 category:'Applications'. |
3056 category:'Applications'. |
3057 |
3057 |
3058 cls name ~= specClass ifTrue:[ |
3058 cls name ~= specClass ifTrue:[ |
3059 self information:'Created new class is ' , cls name. |
3059 self information:'Created new class is ' , cls name. |
3060 specClass := cls name |
3060 specClass := cls name |
3061 ]. |
3061 ]. |
3062 ^ true. |
3062 ^ true. |
3063 ]. |
3063 ]. |
3064 ^ false. |
3064 ^ false. |
3065 ]. |
3065 ]. |
3066 cls isBehavior ifFalse:[ |
3066 cls isBehavior ifFalse:[ |
3067 self warn:'A global named ' , specClass , ' exists, but it is no class.'. |
3067 self warn:'A global named ' , specClass , ' exists, but it is no class.'. |
3068 ^ false. |
3068 ^ false. |
3069 ]. |
3069 ]. |
3070 |
3070 |
3071 specSuperclass isBehavior ifFalse:[ |
3071 specSuperclassName isBehavior ifFalse:[ |
3072 specSuperclass isEmpty ifFalse:[ |
3072 specSuperclassName isEmpty ifFalse:[ |
3073 superclass := self resolveName:specSuperclass |
3073 superclass := self resolveName:specSuperclassName |
3074 ] ifTrue:[ |
3074 ] ifTrue:[ |
3075 specSuperclass := nil. |
3075 specSuperclassName := nil. |
3076 ] |
3076 ] |
3077 ] ifTrue:[ |
3077 ] ifTrue:[ |
3078 superclass := specSuperclass |
3078 superclass := specSuperclassName |
3079 ]. |
3079 ]. |
3080 |
3080 |
3081 specSuperclass notNil ifTrue:[ |
3081 specSuperclassName notNil ifTrue:[ |
3082 superclass isNil ifTrue:[ |
3082 superclass isNil ifTrue:[ |
3083 self warn:'No class named ' , specSuperclass , ' exists!!'. |
3083 self warn:'No class named ' , specSuperclassName , ' exists!!'. |
3084 ^ false. |
3084 ^ false. |
3085 ]. |
3085 ]. |
3086 |
3086 |
3087 (cls isSubclassOf:superclass) ifFalse:[ |
3087 (cls isSubclassOf:superclass) ifFalse:[ |
3088 self information:('A global named ' , specClass , ' exists,\' , |
3088 self information:('A global named ' , specClass , ' exists,\' , |
3089 'but is not a subclass of ' , superclass name , '.\\' , |
3089 'but is not a subclass of ' , superclass name , '.\\' , |
3090 'Check and try again if that is not what you want.') withCRs. |
3090 'Check and try again if that is not what you want.') withCRs. |
3091 ] |
3091 ] |
3092 ]. |
3092 ]. |
3093 |
3093 |
3094 superclass isNil ifTrue:[ |
3094 superclass isNil ifTrue:[ |
3095 cls notNil ifTrue:[ |
3095 cls notNil ifTrue:[ |
3096 specSuperclass := cls superclass name |
3096 specSuperclassName := cls superclass name |
3097 ] |
3097 ] |
3098 ]. |
3098 ]. |
3099 |
3099 |
3100 ^ true |
3100 ^ true |
3101 |
3101 |
3102 "Modified: 12.8.1997 / 23:39:10 / cg" |
3102 "Modified: 12.8.1997 / 23:39:10 / cg" |
3176 superclassName:superClassName |
3155 superclassName:superClassName |
3177 selector:(selector ? ''). |
3156 selector:(selector ? ''). |
3178 |
3157 |
3179 self specClass:clsName. |
3158 self specClass:clsName. |
3180 specSelector := (selector ? ''). |
3159 specSelector := (selector ? ''). |
3181 specSuperclass := superClassName. |
3160 specSuperclassName := superClassName. |
3182 |
3161 |
3183 (specClass notNil and:[ selector notNil ]) ifTrue:[ |
3162 (specClass notNil and:[ selector notNil ]) ifTrue:[ |
3184 self addToHistory: (specClass, ' ', specSelector) -> #loadFromMessage:. |
3163 self addHistoryEntryForClass:specClass selector:specSelector. |
3185 self updateInfoLabel |
3164 self updateInfoLabel |
3186 ]. |
3165 ]. |
3187 |
3166 |
3188 "Modified: / 5.2.1998 / 09:44:58 / stefan" |
3167 "Modified: / 5.2.1998 / 09:44:58 / stefan" |
3189 ! |
3168 ! |
3198 ]. |
3177 ]. |
3199 self layoutTool layoutView:aView type:type spec:aSpec |
3178 self layoutTool layoutView:aView type:type spec:aSpec |
3200 |
3179 |
3201 ! |
3180 ! |
3202 |
3181 |
3203 specClass:aClass |
3182 specClass:aClassOrClassName |
3204 "sets the specClass and updates the Help Tool" |
3183 "sets the specClass and updates the Help Tool" |
3205 |
3184 |
3206 specClass := aClass isBehavior ifTrue:[aClass name] |
3185 aClassOrClassName isBehavior |
3207 ifFalse:[aClass]. |
3186 ifTrue: [ specClass := aClassOrClassName ] |
3208 |
3187 ifFalse:[ specClass := Smalltalk classNamed:aClassOrClassName ]. |
3209 self helpTool buildFromClass:specClass. |
3188 |
|
3189 self helpTool loadFromClass:specClass. |
3210 self clearModifiedFlag. |
3190 self clearModifiedFlag. |
3211 ! ! |
3191 ! ! |
3212 |
3192 |
3213 !UIPainter methodsFor:'private-tools'! |
3193 !UIPainter methodsFor:'private-tools'! |
3214 |
3194 |
3516 ]. |
3496 ]. |
3517 topView raise. |
3497 topView raise. |
3518 ]. |
3498 ]. |
3519 ! |
3499 ! |
3520 |
3500 |
3521 loadFromMessage: aMessageString |
3501 loadFromClass:aClass andSelector:selector |
3522 "loads a window spec by evaluating aMessageString |
3502 "loads a window spec by evaluating aMessageString |
3523 (which is something like 'fooClass windowSpec')" |
3503 (which is something like 'fooClass windowSpec')" |
3524 |
3504 |
3525 |readStream aClass aSelector| |
3505 self assert:(aClass isNil or:[aClass isClass]). |
3526 |
3506 |
3527 ((aMessageString size > 0) and: [self askForModification]) |
3507 self askForModification ifFalse:[^ self]. |
3528 ifTrue:[ |
3508 |
3529 readStream := aMessageString readStream. |
3509 self setClass:aClass selector:selector. |
3530 (aClass := Smalltalk at: (readStream upTo: $ ) asSymbol) notNil |
3510 |
3531 ifTrue:[ |
3511 (aClass respondsTo:selector) ifTrue:[ |
3532 aSelector := readStream upToEnd asSymbol. |
3512 self painter setupFromSpec:(aClass perform:selector). |
3533 self setClass: aClass selector: aSelector. |
3513 ] |
3534 |
3514 ! |
3535 (aClass respondsTo:aSelector) ifTrue:[ |
3515 |
3536 self painter setupFromSpec:(aClass perform:aSelector). |
3516 loadFromMessage:classAndSelector |
3537 ] |
3517 "loads a window spec by evaluating aMessageString |
3538 ] |
3518 (which is something like 'fooClass windowSpec')" |
|
3519 |
|
3520 self askForModification ifFalse:[^ self]. |
|
3521 |
|
3522 classAndSelector notNil ifTrue:[ |
|
3523 self loadFromClass:classAndSelector methodClass andSelector:classAndSelector methodSelector |
3539 ] |
3524 ] |
3540 ! |
3525 ! |
3541 |
3526 |
3542 openInterface:aSymbol |
3527 openInterface:aSymbol |
3543 "opens the interface on the selector aSymbol" |
3528 "opens the interface on the selector aSymbol" |
3554 ] |
3539 ] |
3555 ]. |
3540 ]. |
3556 aspects at:#classNameChannel |
3541 aspects at:#classNameChannel |
3557 put:((specClass notNil ifTrue:[ specClass ] ifFalse:[ 'NewApplication' ]) |
3542 put:((specClass notNil ifTrue:[ specClass ] ifFalse:[ 'NewApplication' ]) |
3558 asValue). |
3543 asValue). |
3559 specSuperclass isNil ifTrue:[ |
3544 |
|
3545 specSuperclassName isNil ifTrue:[ |
3560 specClass notNil ifTrue:[ |
3546 specClass notNil ifTrue:[ |
3561 (cls := self resolveName:specClass) notNil ifTrue:[ |
3547 (cls := self resolveName:specClass) notNil ifTrue:[ |
3562 specSuperclass := cls superclass name. |
3548 specSuperclassName := cls superclass name. |
3563 ] |
3549 ] |
3564 ] |
3550 ] |
3565 ]. |
3551 ]. |
3566 aspects at:#superclassNameChannel |
3552 aspects at:#superclassNameChannel |
3567 put:((specSuperclass notNil |
3553 put:((specSuperclassName notNil |
3568 ifTrue:[ specSuperclass ] |
3554 ifTrue:[ specSuperclassName ] |
3569 ifFalse:[ 'ApplicationModel' ]) asValue). |
3555 ifFalse:[ 'ApplicationModel' ]) asValue). |
3570 aspects at:#superclassNameDefaults |
3556 aspects at:#superclassNameDefaults |
3571 put:#( 'ApplicationModel' 'SimpleDialog' ) asValue. |
3557 put:#( 'ApplicationModel' 'SimpleDialog' ) asValue. |
3572 aspects at:#methodNameChannel |
3558 aspects at:#methodNameChannel |
3573 put:((specSelector notNil |
3559 put:((specSelector notNil |
3924 [ |
3910 [ |
3925 again := false. |
3911 again := false. |
3926 |
3912 |
3927 aspects at:#classNameChannel put:(specClass ? 'NewApplication') asValue. |
3913 aspects at:#classNameChannel put:(specClass ? 'NewApplication') asValue. |
3928 aspects at:#methodNameChannel put:(specSelector ? 'windowSpec') asValue. |
3914 aspects at:#methodNameChannel put:(specSelector ? 'windowSpec') asValue. |
3929 aspects at:#superclassNameChannel put:(specSuperclass ? 'ApplicationModel') asValue. |
3915 aspects at:#superclassNameChannel put:(specSuperclassName ? 'ApplicationModel') asValue. |
3930 |
3916 |
3931 (self openDialogInterface:#dialogSpecForDefiningClassAndSelector) ifTrue:[ |
3917 (self openDialogInterface:#dialogSpecForDefiningClassAndSelector) ifTrue:[ |
3932 specClass := readFromModelKeyed value:#classNameChannel. |
3918 specClass := readFromModelKeyed value:#classNameChannel. |
3933 specSelector := readFromModelKeyed value:#methodNameChannel. |
3919 specSelector := readFromModelKeyed value:#methodNameChannel. |
3934 specSuperclass := readFromModelKeyed value:#superclassNameChannel. |
3920 specSuperclassName := readFromModelKeyed value:#superclassNameChannel. |
3935 |
3921 |
3936 (again := self checkClassAndSelector not) ifFalse:[ |
3922 (again := self checkClassAndSelector not) ifFalse:[ |
3937 self painter className:specClass |
3923 self painter className:specClass |
3938 superclassName:specSuperclass |
3924 superclassName:specSuperclassName |
3939 selector:specSelector. |
3925 selector:specSelector. |
3940 ]. |
3926 ]. |
3941 |
3927 |
3942 again ifFalse:[ |
3928 again ifFalse:[ |
3943 ((Smalltalk at:specClass asSymbol) notNil |
3929 ((Smalltalk at:specClass asSymbol) notNil |
4158 ! |
4144 ! |
4159 |
4145 |
4160 doLoadSubspec |
4146 doLoadSubspec |
4161 "opens a ResourceSelectionBrowser for loading a sub spec from a class" |
4147 "opens a ResourceSelectionBrowser for loading a sub spec from a class" |
4162 |
4148 |
4163 |subSpecMessage| |
4149 |classAndSelector class selector| |
4164 |
4150 |
4165 self askForSectionModification. |
4151 self askForSectionModification. |
4166 |
4152 |
4167 (subSpecMessage := ResourceSelectionBrowser |
4153 classAndSelector := ResourceSelectionBrowser |
4168 request: 'Load Subspec From Class' |
4154 request: 'Load Subspec From Class' |
4169 onSuperclass: nil |
4155 onSuperclass: nil |
4170 andClass: specClass |
4156 andClass: specClass |
4171 andSelector: specSelector |
4157 andSelector: specSelector |
4172 withResourceTypes: #(canvas)) notNil |
4158 withResourceTypes: #(canvas). |
4173 ifTrue: |
4159 |
4174 [ |
4160 classAndSelector isNil ifTrue:[^ self]. |
4175 |readStream aClass aSelector| |
4161 class := classAndSelector methodClass. |
4176 readStream := subSpecMessage readStream. |
4162 selector := classAndSelector methodSelector. |
4177 (aClass := Smalltalk at: (readStream upTo: $ ) asSymbol) notNil |
4163 (class == specClass and: [selector == specSelector]) ifTrue: [ |
4178 ifTrue: |
4164 self warn: 'Current interface as subspec not allowed!!'. |
4179 [ |
4165 ^ self. |
4180 aSelector := readStream upToEnd asSymbol. |
4166 ]. |
4181 (aClass name == specClass and: [aSelector == specSelector]) ifTrue: [^self warn: 'Current interface as subspec not allowed!!']. |
4167 (class respondsTo:selector) ifTrue:[ |
4182 (aClass respondsTo:aSelector) |
4168 self addWidgetOfSpec:(Array with: (UISubSpecification new majorKey: class name; minorKey: selector)) |
4183 ifTrue: |
|
4184 [ |
|
4185 self addWidgetOfSpec: (Array with: (UISubSpecification new majorKey: aClass name; minorKey: aSelector)) |
|
4186 ] |
|
4187 ] |
|
4188 ] |
4169 ] |
4189 ! |
4170 ! |
4190 |
4171 |
4191 doNew |
4172 doNew |
4192 "removes all widgets, specClass, and specSelector" |
4173 "removes all widgets, specClass, and specSelector" |
4239 ! |
4220 ! |
4240 |
4221 |
4241 doSave |
4222 doSave |
4242 "saves the window spec" |
4223 "saves the window spec" |
4243 |
4224 |
4244 |code painter cls| |
4225 |code painter| |
4245 |
4226 |
4246 self askForSectionModification. |
4227 self askForSectionModification. |
4247 self hasSpecClassAndSelector ifFalse:[ |
4228 self hasSpecClassAndSelector ifFalse:[ |
4248 self doDefineClassAndSelector isNil ifTrue:[ |
4229 self doDefineClassAndSelector isNil ifTrue:[ |
4249 ^ nil |
4230 ^ nil |
4250 ] |
4231 ] |
4251 ]. |
4232 ]. |
4252 |
4233 |
4253 (specClass notNil |
4234 (specClass notNil and:[ specClass isClass ]) ifFalse:[ |
4254 and:[ (cls := Smalltalk at:specClass asSymbol) isClass ]) |
4235 self warn:('Oops - cannot save - class not found: ' , specClass). |
4255 ifFalse:[ |
4236 ^ nil |
4256 self warn:('Oops - cannot save - class not found: ' , specClass). |
4237 ]. |
4257 ^ nil |
|
4258 ]. |
|
4259 painter := self painter. |
4238 painter := self painter. |
4260 painter |
4239 painter |
4261 className:specClass |
4240 class:specClass |
4262 superclassName:specSuperclass |
4241 superclassName:specSuperclassName |
4263 selector:specSelector. |
4242 selector:specSelector. |
4264 |
4243 |
4265 "/ Transcript showCR:'generating windowSpec code...'. |
4244 "/ Transcript showCR:'generating windowSpec code...'. |
4266 |
4245 |
4267 (painter topView extent > (800 @ 600)) ifTrue:[ |
4246 (painter topView extent > (800 @ 600)) ifTrue:[ |
4276 self doGenerateAspectSelectorsMethod. |
4255 self doGenerateAspectSelectorsMethod. |
4277 self helpTool doSave. |
4256 self helpTool doSave. |
4278 self updateInfoLabel. |
4257 self updateInfoLabel. |
4279 modified := false. |
4258 modified := false. |
4280 painter resetModification. |
4259 painter resetModification. |
4281 (cls class includesSelector:specSelector) ifTrue:[ |
4260 (specClass respondsTo:specSelector) ifTrue:[ |
4282 self addToHistory:(specClass , ' ' , specSelector) -> #loadFromMessage:. |
4261 self addHistoryEntryForClass:specClass selector:specSelector. |
4283 ]. |
4262 ]. |
4284 ! |
4263 ! |
4285 |
4264 |
4286 doSaveAs |
4265 doSaveAs |
4287 "opens a ResourceSelectionBrowser for saving the window spec on a class" |
4266 "opens a ResourceSelectionBrowser for saving the window spec on a class" |
4288 |
4267 |
4289 |resourceMessage| |
4268 |classAndSelector| |
4290 |
4269 |
4291 self askForSectionModification. |
4270 self askForSectionModification. |
4292 |
4271 self askForModification ifFalse:[^ false]. |
4293 (resourceMessage := ResourceSelectionBrowser |
4272 |
4294 request: 'Save Window Spec In Class' |
4273 classAndSelector := ResourceSelectionBrowser |
4295 onSuperclass: #Object |
4274 request: 'Save Window Spec In Class' |
4296 andClass: (specClass ? #ApplicationModel) asSymbol |
4275 onSuperclass: #Object |
4297 andSelector: specSelector ? #windowSpec |
4276 andClass: (specClass ? #ApplicationModel) asSymbol |
4298 withResourceTypes: #(canvas)) notNil |
4277 andSelector: specSelector ? #windowSpec |
4299 ifTrue: |
4278 withResourceTypes: #(canvas). |
4300 [ |
4279 |
4301 modified := false. |
4280 classAndSelector isNil ifTrue:[^ false]. |
4302 self painter resetModification. |
4281 |
4303 (self resourceMessage: resourceMessage) |
4282 modified := false. |
4304 ifTrue: |
4283 self painter resetModification. |
4305 [ |
4284 |
4306 self doSave. |
4285 specClass := classAndSelector methodClass. |
4307 ^true |
4286 specSelector := classAndSelector methodSelector. |
4308 ] |
4287 specSuperclassName := specClass superclass name. |
4309 ] |
4288 self doSave. |
4310 |
4289 ^ true |
4311 ! |
4290 ! |
4312 |
4291 |
4313 doStartApplication |
4292 doStartApplication |
4314 "starts the application on the editing window spec" |
4293 "starts the application on the editing window spec" |
4315 |
4294 |