diff -r 14b7babca4f5 -r 969584dd8beb UIPainter.st --- 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