--- a/UIPainter.st Mon Feb 13 09:53:10 2006 +0100
+++ b/UIPainter.st Mon Feb 13 09:54:17 2006 +0100
@@ -14,7 +14,7 @@
"{ Package: 'stx:libtool2' }"
ToolApplicationModel subclass:#UIPainter
- instanceVariableNames:'specClass specSelector specSuperclass aspects treeView
+ instanceVariableNames:'specClass specSelector specSuperclassName aspects treeView
selectionPanel tabSelection modified specTool layoutTool helpTool'
classVariableNames:''
poolDictionaries:''
@@ -73,9 +73,9 @@
!UIPainter class methodsFor:'instance creation'!
openOnClass:aClass andSelector:aSelector
- "open a GUI Painter on aClass and (windowSpec) aSelector
- "
- ^ self new openOnClass:aClass andSelector:aSelector
+ "open a GUI Painter on aClass and (windowSpec) aSelector"
+
+ ^ self new openOnClass:aClass theNonMetaclass andSelector:aSelector
! !
!UIPainter class methodsFor:'ST-80 queries'!
@@ -2430,7 +2430,7 @@
applBuilder := helpTool builder.
applWindow := ApplicationSubView origin:0.0@0.0 corner:1.0@1.0 in:noteBook.
applWindow level:0.
- helpTool buildFromClass:specClass.
+ helpTool loadFromClass:specClass.
helpTool masterApplication:self.
applBuilder window:applWindow.
applWindow client:helpTool spec:#windowSpec builder:applBuilder.
@@ -3040,61 +3040,61 @@
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:[
- 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.
+ superclass := self resolveName:specSuperclassName.
+
+ superclass isNil ifTrue:[
+ self warn:'No class named ' , specSuperclassName , ' 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.
- ]
+ specSuperclassName isBehavior ifFalse:[
+ specSuperclassName isEmpty ifFalse:[
+ superclass := self resolveName:specSuperclassName
+ ] ifTrue:[
+ specSuperclassName := nil.
+ ]
] ifTrue:[
- superclass := specSuperclass
+ superclass := specSuperclassName
].
- 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.
- ]
+ specSuperclassName notNil ifTrue:[
+ superclass isNil ifTrue:[
+ self warn:'No class named ' , specSuperclassName , ' 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:[
+ specSuperclassName := cls superclass name
+ ]
].
^ true
@@ -3138,27 +3138,6 @@
aView bePartner.
!
-resourceMessage: aString
- "reads the specClass and the specSelector by evaluating aString"
-
- (aString notNil and: [self askForModification])
- ifTrue:
- [
- |msg cls sel|
- msg := aString asCollectionOfWords.
- (msg size == 2 and:
- [(cls := self resolveName:(msg at:1)) notNil])
- ifTrue:
- [
- self specClass:cls.
- specSuperclass := cls superclass name.
- specSelector := (msg at: 2) asSymbol.
- ^true
- ]
- ].
- ^false
-!
-
setClass:cls selector:selector
"sets the specClass and the specSelector under which the window spec should be saved"
@@ -3178,10 +3157,10 @@
self specClass:clsName.
specSelector := (selector ? '').
- specSuperclass := superClassName.
+ specSuperclassName := superClassName.
(specClass notNil and:[ selector notNil ]) ifTrue:[
- self addToHistory: (specClass, ' ', specSelector) -> #loadFromMessage:.
+ self addHistoryEntryForClass:specClass selector:specSelector.
self updateInfoLabel
].
@@ -3200,13 +3179,14 @@
!
-specClass:aClass
+specClass:aClassOrClassName
"sets the specClass and updates the Help Tool"
- specClass := aClass isBehavior ifTrue:[aClass name]
- ifFalse:[aClass].
-
- self helpTool buildFromClass:specClass.
+ aClassOrClassName isBehavior
+ ifTrue: [ specClass := aClassOrClassName ]
+ ifFalse:[ specClass := Smalltalk classNamed:aClassOrClassName ].
+
+ self helpTool loadFromClass:specClass.
self clearModifiedFlag.
! !
@@ -3518,24 +3498,29 @@
].
!
-loadFromMessage: aMessageString
+loadFromClass:aClass andSelector:selector
"loads a window spec by evaluating aMessageString
(which is something like 'fooClass windowSpec')"
- |readStream aClass aSelector|
-
- ((aMessageString size > 0) and: [self askForModification])
- ifTrue:[
- readStream := aMessageString readStream.
- (aClass := Smalltalk at: (readStream upTo: $ ) asSymbol) notNil
- ifTrue:[
- aSelector := readStream upToEnd asSymbol.
- self setClass: aClass selector: aSelector.
-
- (aClass respondsTo:aSelector) ifTrue:[
- self painter setupFromSpec:(aClass perform:aSelector).
- ]
- ]
+ self assert:(aClass isNil or:[aClass isClass]).
+
+ self askForModification ifFalse:[^ self].
+
+ self setClass:aClass selector:selector.
+
+ (aClass respondsTo:selector) ifTrue:[
+ self painter setupFromSpec:(aClass perform:selector).
+ ]
+!
+
+loadFromMessage:classAndSelector
+ "loads a window spec by evaluating aMessageString
+ (which is something like 'fooClass windowSpec')"
+
+ self askForModification ifFalse:[^ self].
+
+ classAndSelector notNil ifTrue:[
+ self loadFromClass:classAndSelector methodClass andSelector:classAndSelector methodSelector
]
!
@@ -3556,16 +3541,17 @@
aspects at:#classNameChannel
put:((specClass notNil ifTrue:[ specClass ] ifFalse:[ 'NewApplication' ])
asValue).
- specSuperclass isNil ifTrue:[
+
+ specSuperclassName isNil ifTrue:[
specClass notNil ifTrue:[
(cls := self resolveName:specClass) notNil ifTrue:[
- specSuperclass := cls superclass name.
+ specSuperclassName := cls superclass name.
]
]
].
aspects at:#superclassNameChannel
- put:((specSuperclass notNil
- ifTrue:[ specSuperclass ]
+ put:((specSuperclassName notNil
+ ifTrue:[ specSuperclassName ]
ifFalse:[ 'ApplicationModel' ]) asValue).
aspects at:#superclassNameDefaults
put:#( 'ApplicationModel' 'SimpleDialog' ) asValue.
@@ -3626,11 +3612,11 @@
!
openOnClass:aClass andSelector:aSelector
- "opens the GUI Painter on aClass and aSelector
- "
+ "opens the GUI Painter on aClass and aSelector"
+
aClass isNil ifTrue:[
- (self confirm:'No class given to the GUI Painter (class was probably renamed?)\\Open anyway (to create a new window spec) ?' withCRs)
- ifFalse:[^ nil].
+ (self confirm:'No class given to the GUI Painter (class was probably renamed?)\\Open anyway (to create a new window spec) ?' withCRs)
+ ifFalse:[^ nil].
].
specSelector := aSelector.
@@ -3926,16 +3912,16 @@
aspects at:#classNameChannel put:(specClass ? 'NewApplication') asValue.
aspects at:#methodNameChannel put:(specSelector ? 'windowSpec') asValue.
- aspects at:#superclassNameChannel put:(specSuperclass ? 'ApplicationModel') asValue.
+ aspects at:#superclassNameChannel put:(specSuperclassName ? 'ApplicationModel') asValue.
(self openDialogInterface:#dialogSpecForDefiningClassAndSelector) ifTrue:[
specClass := readFromModelKeyed value:#classNameChannel.
specSelector := readFromModelKeyed value:#methodNameChannel.
- specSuperclass := readFromModelKeyed value:#superclassNameChannel.
+ specSuperclassName := readFromModelKeyed value:#superclassNameChannel.
(again := self checkClassAndSelector not) ifFalse:[
self painter className:specClass
- superclassName:specSuperclass
+ superclassName:specSuperclassName
selector:specSelector.
].
@@ -4160,31 +4146,26 @@
doLoadSubspec
"opens a ResourceSelectionBrowser for loading a sub spec from a class"
- |subSpecMessage|
+ |classAndSelector class selector|
self askForSectionModification.
- (subSpecMessage := ResourceSelectionBrowser
- request: 'Load Subspec From Class'
- onSuperclass: nil
- andClass: specClass
- andSelector: specSelector
- withResourceTypes: #(canvas)) notNil
- ifTrue:
- [
- |readStream aClass aSelector|
- readStream := subSpecMessage readStream.
- (aClass := Smalltalk at: (readStream upTo: $ ) asSymbol) notNil
- ifTrue:
- [
- aSelector := readStream upToEnd asSymbol.
- (aClass name == specClass and: [aSelector == specSelector]) ifTrue: [^self warn: 'Current interface as subspec not allowed!!'].
- (aClass respondsTo:aSelector)
- ifTrue:
- [
- self addWidgetOfSpec: (Array with: (UISubSpecification new majorKey: aClass name; minorKey: aSelector))
- ]
- ]
+ classAndSelector := ResourceSelectionBrowser
+ request: 'Load Subspec From Class'
+ onSuperclass: nil
+ andClass: specClass
+ andSelector: specSelector
+ withResourceTypes: #(canvas).
+
+ classAndSelector isNil ifTrue:[^ self].
+ class := classAndSelector methodClass.
+ selector := classAndSelector methodSelector.
+ (class == specClass and: [selector == specSelector]) ifTrue: [
+ self warn: 'Current interface as subspec not allowed!!'.
+ ^ self.
+ ].
+ (class respondsTo:selector) ifTrue:[
+ self addWidgetOfSpec:(Array with: (UISubSpecification new majorKey: class name; minorKey: selector))
]
!
@@ -4241,7 +4222,7 @@
doSave
"saves the window spec"
- |code painter cls|
+ |code painter|
self askForSectionModification.
self hasSpecClassAndSelector ifFalse:[
@@ -4250,16 +4231,14 @@
]
].
- (specClass notNil
- and:[ (cls := Smalltalk at:specClass asSymbol) isClass ])
- ifFalse:[
- self warn:('Oops - cannot save - class not found: ' , specClass).
- ^ nil
- ].
+ (specClass notNil and:[ specClass isClass ]) ifFalse:[
+ self warn:('Oops - cannot save - class not found: ' , specClass).
+ ^ nil
+ ].
painter := self painter.
painter
- className:specClass
- superclassName:specSuperclass
+ class:specClass
+ superclassName:specSuperclassName
selector:specSelector.
"/ Transcript showCR:'generating windowSpec code...'.
@@ -4278,36 +4257,36 @@
self updateInfoLabel.
modified := false.
painter resetModification.
- (cls class includesSelector:specSelector) ifTrue:[
- self addToHistory:(specClass , ' ' , specSelector) -> #loadFromMessage:.
+ (specClass respondsTo:specSelector) ifTrue:[
+ self addHistoryEntryForClass:specClass selector:specSelector.
].
!
doSaveAs
"opens a ResourceSelectionBrowser for saving the window spec on a class"
- |resourceMessage|
+ |classAndSelector|
self askForSectionModification.
-
- (resourceMessage := ResourceSelectionBrowser
- request: 'Save Window Spec In Class'
- onSuperclass: #Object
- andClass: (specClass ? #ApplicationModel) asSymbol
- andSelector: specSelector ? #windowSpec
- withResourceTypes: #(canvas)) notNil
- ifTrue:
- [
- modified := false.
- self painter resetModification.
- (self resourceMessage: resourceMessage)
- ifTrue:
- [
- self doSave.
- ^true
- ]
- ]
-
+ self askForModification ifFalse:[^ false].
+
+ classAndSelector := ResourceSelectionBrowser
+ request: 'Save Window Spec In Class'
+ onSuperclass: #Object
+ andClass: (specClass ? #ApplicationModel) asSymbol
+ andSelector: specSelector ? #windowSpec
+ withResourceTypes: #(canvas).
+
+ classAndSelector isNil ifTrue:[^ false].
+
+ modified := false.
+ self painter resetModification.
+
+ specClass := classAndSelector methodClass.
+ specSelector := classAndSelector methodSelector.
+ specSuperclassName := specClass superclass name.
+ self doSave.
+ ^ true
!
doStartApplication