--- a/UIPainter.st Thu Jul 08 17:10:15 1999 +0200
+++ b/UIPainter.st Thu Jul 08 20:12:42 1999 +0200
@@ -2344,61 +2344,68 @@
checkClassAndSelector
"checks for class & superclass"
- |superclass cls|
+ |superclass cls ns|
specClass isNil ifTrue:[^ false].
cls := self resolveName:specClass.
cls isNil ifTrue:[
- superclass := self resolveName:specSuperclass.
-
- superclass isNil ifTrue:[
- self warn:'No class named ' , specSuperclass , ' exists!!'.
- ^ false.
- ].
- (self confirm:'Create class ' , specClass asBoldText, '?') ifTrue:[
- superclass subclass:(specClass asSymbol)
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Applications'.
- ^ true.
- ].
- ^ false.
+ superclass := self resolveName:specSuperclass.
+
+ superclass isNil ifTrue:[
+ self warn:'No class named ' , specSuperclass , ' exists!!'.
+ ^ false.
+ ].
+
+ (self confirm:'Create class ' , specClass asBoldText, '?') ifTrue:[
+ cls := superclass
+ subclass:(specClass asSymbol)
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Applications'.
+
+ cls name ~= specClass ifTrue:[
+ self information:'Created new class is ' , cls name.
+ specClass := cls name
+ ].
+ ^ true.
+ ].
+ ^ false.
].
cls isBehavior ifFalse:[
- self warn:'A global named ' , specClass , ' exists, but it is no class.'.
- ^ false.
+ self warn:'A global named ' , specClass , ' exists, but it is no class.'.
+ ^ false.
].
specSuperclass isBehavior ifFalse:[
- specSuperclass isEmpty ifFalse:[
- superclass := self resolveName:specSuperclass
- ] ifTrue:[
- specSuperclass := nil.
- ]
+ specSuperclass isEmpty ifFalse:[
+ superclass := self resolveName:specSuperclass
+ ] ifTrue:[
+ specSuperclass := nil.
+ ]
] ifTrue:[
- superclass := specSuperclass
+ superclass := specSuperclass
].
specSuperclass notNil ifTrue:[
- superclass isNil ifTrue:[
- self warn:'No class named ' , specSuperclass , ' exists!!'.
- ^ false.
- ].
-
- (cls isSubclassOf:superclass) ifFalse:[
- self information:('A global named ' , specClass , ' exists,\' ,
- 'but is not a subclass of ' , superclass name , '.\\' ,
- 'Check and try again if that is not what you want.') withCRs.
- ]
+ superclass isNil ifTrue:[
+ self warn:'No class named ' , specSuperclass , ' exists!!'.
+ ^ false.
+ ].
+
+ (cls isSubclassOf:superclass) ifFalse:[
+ self information:('A global named ' , specClass , ' exists,\' ,
+ 'but is not a subclass of ' , superclass name , '.\\' ,
+ 'Check and try again if that is not what you want.') withCRs.
+ ]
].
superclass isNil ifTrue:[
- cls notNil ifTrue:[
- specSuperclass := cls superclass name
- ]
+ cls notNil ifTrue:[
+ specSuperclass := cls superclass name
+ ]
].
^ true
@@ -3326,40 +3333,60 @@
doSave
"saves the window spec"
- |code painter|
+ |code painter cls ns|
self askForSectionModification.
self hasSpecClassAndSelector ifFalse:[
- self doDefineClassAndSelector isNil ifTrue: [^nil]
+ self doDefineClassAndSelector isNil ifTrue: [^nil]
].
- (specClass notNil and: [(Smalltalk at: specClass asSymbol) isClass])
- ifFalse:
- [
- ^nil
+ specClass notNil ifTrue:[
+ (specClass includes:$:) ifFalse:[
+ (ns := Smalltalk defaultNameSpace) notNil ifTrue:[
+ cls := ns at:specClass asSymbol
+ ].
+ ].
+ cls isNil ifTrue:[
+ (specClass startsWith:'Smalltalk::') ifTrue:[
+ cls := Smalltalk at: (specClass copyFrom:12) asSymbol.
+ ] ifFalse:[
+ cls := Smalltalk at: specClass asSymbol.
+ ]
+ ].
+ ns := cls nameSpace.
+ ].
+ cls isClass ifFalse:[
+ self warn:('Oops - cannot save - class not found: ' , specClass).
+ ^nil
+ ].
+
+ ns ~~ Smalltalk defaultNameSpace ifTrue:[
+ specClass := ns name , '::' , cls nameWithoutNameSpacePrefix.
+ ] ifFalse:[
+ specClass := cls name.
].
painter := self painter.
-
- painter className:specClass
- superclassName:specSuperclass
- selector:specSelector.
+ painter
+ className:specClass
+ superclassName:specSuperclass
+ selector:specSelector.
code := painter generateWindowSpecMethodSource withCRs.
+ Transcript showCR:'generating windowSpec code...'.
+
(ReadStream on:code) fileIn.
self helpTool installHelpSpecsOnClass:specClass.
self updateInfoLabel.
modified := false.
- self painter resetModification.
-
- ((Smalltalk at: specClass asSymbol) class implements: specSelector)
- ifTrue:
- [
- self addToHistory: (specClass, ' ', specSelector) -> #loadFromMessage:.
+ painter resetModification.
+
+ (cls class implements: specSelector) ifTrue:[
+ self addToHistory: (specClass, ' ', specSelector) -> #loadFromMessage:.
].
@@ -3395,26 +3422,31 @@
doStartApplication
"starts the application on the editing window spec"
- |application|
+ |cls application|
self hasSpecClassAndSelector ifFalse:[
- self doSave isNil ifTrue: [^nil].
+ self doSave isNil ifTrue: [^nil].
] ifTrue: [
- self askForSectionModification.
- (modified or: [self painter isModified or: [self helpTool modified]])
- ifTrue:
- [
- ((YesNoBox title:'Window Spec was modified!!')
- noText:'Cancel';
- yesText:'Save it and start';
- showAtPointer;
- accepted) ifFalse: [^nil].
- self doSave isNil ifTrue: [^nil]
- ]
+ self askForSectionModification.
+ (modified or: [self painter isModified or: [self helpTool modified]])
+ ifTrue:
+ [
+ ((YesNoBox title:'Window Spec was modified!!')
+ noText:'Cancel';
+ yesText:'Save it and start';
+ showAtPointer;
+ accepted) ifFalse: [^nil].
+ self doSave isNil ifTrue: [^nil]
+ ]
].
- ((application := (self resolveName:specClass) new) respondsTo:#openInterface:) ifFalse:[
- ^ self warn:('The application does not respond to the ''openInterface:'' message.\\(maybe its supposed to be used as subApplication/subCanvas)') withCRs.
+ cls := self resolveName:specClass.
+ cls isNil ifTrue:[
+ self warn:'Oops cannot start application - no class:' , specClass.
+ ^ nil
+ ].
+ ((application := cls new) respondsTo:#openInterface:) ifFalse:[
+ ^ self warn:('The application does not respond to the ''openInterface:'' message.\\(maybe its supposed to be used as subApplication/subCanvas)') withCRs.
].
application openInterface:specSelector
!