ApplicationModel subclass:#UIPainter
instanceVariableNames:'objectList currentView selectionPanel tabSelection lastSlice
specView layoutTool fileName specClass specSelector
specSuperclass aspects'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
!
!UIPainter class methodsFor:'documentation'!
documentation
"
GUI-Builder:
this class allows the user to build its own applications providing a graphical
user interface to buildin components and to define the behavior of the components
during runtime. The resulting specifications can be installed as methods on
classes, typically subclasses of an ApplicationModel. These specifications
are used by the UIBuilder to generate the application window and its component
structues when open the application.
[start with:]
UIPainter open
[see also:]
UIBuilder
ApplicationModel
UISpecification
"
! !
!UIPainter class methodsFor:'instance creation'!
listHolder:aListHolder
|application|
application := self new.
application objectList:aListHolder.
^ application open
!
painter:aBuilderView
|application|
application := self new.
application painter:aBuilderView.
^ application open
! !
!UIPainter class methodsFor:'ST-80 queries'!
preferenceFor:aSymbol
^ false
! !
!UIPainter class methodsFor:'constants'!
titleOfLayoutMenu
^ 'Dimension'
! !
!UIPainter class methodsFor:'icons'!
iconAlignB
^ Image fromFile:'b_alignB.xbm'
!
iconAlignCenterH
^ Image fromFile:'b_alignCH.xbm'
!
iconAlignCenterV
^ Image fromFile:'b_alignCV.xbm'
!
iconAlignL
^ Image fromFile:'b_alignL.xbm'
!
iconAlignLR
^ Image fromFile:'b_alignLR.xbm'
!
iconAlignR
^ Image fromFile:'b_alignR.xbm'
!
iconAlignT
^ Image fromFile:'b_alignT.xbm'
!
iconAlignTB
^ Image fromFile:'b_alignTB.xbm'
! !
!UIPainter class methodsFor:'interface specs'!
menuAlignment
^ #(#Menu #(
#(#MenuItem
#'label:' 'align left'
#'value:' #alignSelectionLeft
#'labelImage:' #( ResourceRetriever nil iconAlignL )
)
#(#MenuItem
#'label:' 'align right'
#'value:' #alignSelectionRight
#'labelImage:' #( ResourceRetriever nil iconAlignR )
)
#(#MenuItem
#'label:' 'align left & right'
#'value:' #alignSelectionLeftAndRight
#'labelImage:' #( ResourceRetriever nil iconAlignLR )
)
#(#MenuItem
#'label:' 'align top'
#'value:' #alignSelectionTop
#'labelImage:' #( ResourceRetriever nil iconAlignT )
)
#(#MenuItem
#'label:' 'align bottom'
#'value:' #alignSelectionBottom
#'labelImage:' #( ResourceRetriever nil iconAlignB )
)
#(#MenuItem
#'label:' 'align top & bottom'
#'value:' #alignSelectionTopAndBottom
#'labelImage:' #( ResourceRetriever nil iconAlignTB )
)
#(#MenuItem
#'label:' 'align centered horizontal'
#'value:' #alignSelectionCenterHor
#'labelImage:' #( ResourceRetriever nil iconAlignCenterH )
)
#(#MenuItem
#'label:' 'align centered vertical'
#'value:' #alignSelectionCenterVer
#'labelImage:' #( ResourceRetriever nil iconAlignCenterV )
)
)
#( 4 2 )
nil
)
!
menuPullDown
^ #(#Menu #(
#(#MenuItem
#'label:' 'file'
#'value:' #file
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'new'
#'value:' #removeAll
)
#(#MenuItem
#'label:' 'from class ...'
#'value:' #doFromClass
)
#(#MenuItem
#'label:' 'pick a view '
#'value:' #doPickAView
)
#(#MenuItem
#'label:' 'raise'
#'value:' #doRaise
)
#(#MenuItem
#'label:' 'quit'
#'value:' #closeRequest
)
)
#(3 1)
nil
)
)
#(#MenuItem
#'label:' 'font'
#'value:' #font
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'larger'
#'value:' #largerFont
)
#(#MenuItem
#'label:' 'smaller'
#'value:' #smallerFont
)
#(#MenuItem
#'label:' 'normal'
#'value:' #normalFont
)
#(#MenuItem
#'label:' 'bold'
#'value:' #boldFont
)
#(#MenuItem
#'label:' 'italic'
#'value:' #italicFont
)
#(#MenuItem
#'label:' 'bold italic'
#'value:' #boldItalicFont
)
#(#MenuItem
#'label:' 'font panel'
#'value:' #showFontPanel
)
)
#(2 4)
nil
)
)
#(#MenuItem
#'label:' 'special'
#'value:' #special
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'group radioButtons'
#'value:' #groupRadioButtons
)
#(#MenuItem
#'label:' 'group enterFields'
#'value:' #groupEnterFields
)
)
nil
nil
)
)
#(#MenuItem
#'label:' 'misc'
#'value:' #misc
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'grid'
#'value:' #grid
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' '\c show'
#'value:' #gridShown
)
#(#MenuItem
#'label:' '\c align'
#'value:' #gridAlign
)
)
nil
nil
)
)
#(#MenuItem
#'label:' 'undo'
#'value:' #undo
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'last'
#'value:' #undoLast
)
#(#MenuItem
#'label:' 'menu'
#'value:' #openUndoMenu
)
#(#MenuItem
#'label:' 'delete'
#'value:' #removeUndoHistory
)
)
#(2)
nil
)
)
)
nil
nil
)
)
#(#MenuItem
#'label:' 'code'
#'value:' #code
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'class && method'
#'value:' #defineClassAndSelector
)
#(#MenuItem
#'label:' 'install spec'
#'value:' #doInstallSpec
)
#(#MenuItem
#'label:' 'install aspects'
#'value:' #doInstallAspects
)
#(#MenuItem
#'label:' 'windowSpec'
#'value:' #doWindowSpec
)
#(#MenuItem
#'label:' 'browse'
#'value:' #browseAppClass
)
)
#( 1 2 1)
nil
)
)
#(#MenuItem
#'label:' 'test'
#'nameKey:' #test
#'value:' #test
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' '\c test mode'
#'value:' #testMode
)
)
nil
nil
)
)
)
nil
nil
)
!
nameAndSelectorSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:UIPainter andSelector:#nameAndSelectorSpec
UIPainter new openInterface:#nameAndSelectorSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'unnamed canvas'
#'bounds:' #(#Rectangle 0 0 300 223)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'label1'
#'layout:' #(#LayoutFrame 10 0 50 0 110 0 70 0)
#'label:' 'class:'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'initiallyInvisible:' false
#'translateLabel:' false
#'level:' 0
#'adjust:' #right
#'hasCharacterOrientedLabel:' true
)
#(#LabelSpec
#'name:' 'label2'
#'layout:' #(#LayoutFrame 10 0 90 0 110 0 110 0)
#'label:' 'superclass:'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'initiallyInvisible:' false
#'translateLabel:' false
#'level:' 0
#'adjust:' #right
#'hasCharacterOrientedLabel:' true
)
#(#LabelSpec
#'name:' 'label3'
#'layout:' #(#LayoutFrame 10 0 130 0 110 0 150 0)
#'label:' 'selector:'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'initiallyInvisible:' false
#'translateLabel:' false
#'level:' 0
#'adjust:' #right
#'hasCharacterOrientedLabel:' true
)
#(#InputFieldSpec
#'name:' 'classNameField'
#'layout:' #(#LayoutFrame 120 0 50 0 289 0 72 0)
#'model:' #classNameChannel
#'tabable:' true
#'immediateAccept:' true
#'hasBorder:' false
)
#(#InputFieldSpec
#'name:' 'superclassNameField'
#'layout:' #(#LayoutFrame 120 0 90 0 289 0 112 0)
#'model:' #superclassNameChannel
#'tabable:' true
#'immediateAccept:' true
#'hasBorder:' false
)
#(#InputFieldSpec
#'name:' 'methodNameField'
#'layout:' #(#LayoutFrame 120 0 130 0 289 0 152 0)
#'model:' #methodNameChannel
#'tabable:' true
#'immediateAccept:' true
#'hasBorder:' false
)
#(#ActionButtonSpec
#'name:' 'button1'
#'layout:' #(#LayoutFrame 30 0 180 0 129 0 209 0)
#'label:' 'cancel'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'translateLabel:' false
#'tabable:' true
#'model:' #cancel
#'isTriggerOnDown:' false
)
#(#ActionButtonSpec
#'name:' 'button2'
#'layout:' #(#LayoutFrame 160 0 180 0 259 0 209 0)
#'label:' 'ok'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'translateLabel:' false
#'tabable:' true
#'isDefault:' true
#'model:' #accept
#'isTriggerOnDown:' false
)
#(#LabelSpec
#'name:' 'boxLabel'
#'layout:' #(#LayoutFrame 0 0.0 11 0 0 1.0 32 0)
#'label:' 'class & selector for code:'
#'foregroundColor:' #(#Color 0.0 0.0 0.0)
#'backgroundColor:' #(#Color 66.9993 66.9993 66.9993)
#'initiallyInvisible:' false
#'translateLabel:' false
#'level:' 0
#'adjust:' #left
#'hasCharacterOrientedLabel:' true
)
)
)
)
!
windowSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:UIPainter andSelector:#windowSpec
UIPainter new openInterface:#windowSpec
"
"UIPainter open"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Tree-View'
#'bounds:' #(#Rectangle 0 0 460 390)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ViewSpec
#'name:' 'view1'
#'layout:' #(#LayoutFrame 0 0.0 29 0.0 0 1.0 0 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#SequenceViewSpec
#'name:' 'selectionInList'
#'layout:' #(#LayoutFrame 0 0.0 40 0.0 0 0.35 0 1.0)
#'enableChannel:' #enableChannel
#'menu:' #objectListMenu
#'model:' #objectList
#'callbacksSpec:'
#(#UIEventCallbackSubSpec
#'doubleClickSelector:' #doubleClick
)
#'hasHorizontalScrollBar:' true
#'hasVerticalScrollBar:' true
#'miniScrollerHorizontal:' false
#'miniScrollerVertical:' false
#'isMultiSelect:' true
)
#(#PanelViewSpec
#'name:' 'panelViewButtons'
#'layout:' #(#LayoutFrame -130 1.0 0 0.0 0 1.0 35 0.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'moveLeft'
#'label:' ''
#'translateLabel:' true
#'labelChannel:' #'LABELb_moveLeft.xbm'
#'defaultable:' true
#'model:' #moveSelectionLeft
#'isTriggerOnDown:' true
#'enableChannel:' #enableChannel
#'autoRepeat:' true
#'extent:' #(#Point 26 24)
)
#(#ActionButtonSpec
#'name:' 'moveRight'
#'label:' ''
#'translateLabel:' true
#'labelChannel:' #'LABELb_moveRight.xbm'
#'defaultable:' true
#'model:' #moveSelectionRight
#'isTriggerOnDown:' true
#'enableChannel:' #enableChannel
#'autoRepeat:' true
#'extent:' #(#Point 26 24)
)
#(#ActionButtonSpec
#'name:' 'moveUp'
#'label:' ''
#'translateLabel:' true
#'labelChannel:' #'LABELb_moveUp.xbm'
#'defaultable:' true
#'model:' #moveSelectionUp
#'isTriggerOnDown:' true
#'enableChannel:' #enableChannel
#'autoRepeat:' true
#'extent:' #(#Point 26 24)
)
#(#ActionButtonSpec
#'name:' 'moveDown'
#'label:' ''
#'translateLabel:' true
#'labelChannel:' #'LABELb_moveDown.xbm'
#'defaultable:' true
#'model:' #moveSelectionDown
#'isTriggerOnDown:' true
#'enableChannel:' #enableChannel
#'autoRepeat:' true
#'extent:' #(#Point 26 24)
)
)
)
#'level:' 1
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fitSpace
#'horizontalSpace:' 4
#'verticalSpace:' 4
)
#(#NoteBookViewSpec
#'name:' 'propertyView'
#'layout:' #(#LayoutFrame 0 0.35 40 0.0 0 1.0 -30 1.0)
#'model:' #tabModel
#'menu:' #tabList
#'tabWidget:' #Window
#'direction:' #top
#'useIndex:' false
#'fitLastRow:' true
#'moveSelectedRow:' true
#'enableChannel:' #enableChannel
#'level:' 0
#'canvas:' #noteBookView
)
#(#HorizontalPanelViewSpec
#'name:' 'hrzPanelViewOk'
#'layout:' #(#LayoutFrame 0 0.35 -30 1.0 0 1.0 0 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'cancelButton'
#'label:' 'cancel'
#'model:' #cancel
#'isTriggerOnDown:' false
#'enableChannel:' #modifiedChannel
#'autoRepeat:' false
#'extent:' #(#Point 145 24)
)
#(#ActionButtonSpec
#'name:' 'acceptButton'
#'label:' 'ok'
#'model:' #accept
#'isTriggerOnDown:' false
#'enableChannel:' #modifiedChannel
#'autoRepeat:' false
#'extent:' #(#Point 145 24)
)
)
)
#'level:' 0
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fitSpace
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
#(#MenuPanelSpec
#'name:' 'menuPanel1'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 -226 1.0 25 0)
#'menu:' #menuAlignment
#'showSeparatingLines:' true
#'verticalLayout:' false
#'fitFirstPanel:' true
)
)
)
)
#(#MenuPanelSpec
#'name:' 'menuBar1'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 24 0)
#'menu:' #menuPullDown
#'showSeparatingLines:' false
#'verticalLayout:' false
#'fitFirstPanel:' true
)
)
)
)
! !
!UIPainter methodsFor:'actions'!
accept
"automatically generated by UIPainter ..."
|layout|
currentView notNil ifTrue:[
tabSelection = 'Dimension' ifTrue:[
(layout := layoutTool layout) notNil ifTrue:[
layoutTool layoutType == #Extent ifTrue:[
self painter setExtent:layout
] ifFalse:[
self painter setDimension:layout
]
]
] ifFalse:[
self painter updateFromSpec:(specView specEdited).
].
self cancel
]
!
cancel
"cancel all changes and read back attributes from current view
"
specView specEdited:(self painter specFor:currentView).
layoutTool forView:currentView.
self modifiedChannel value:false.
! !
!UIPainter methodsFor:'aspects'!
doubleClick
objectList selectGroup
!
enableChannel
"true if modifications are allowed otherwise running test
"
^ self painter enableChannel
!
menuAlignment
|menu channel|
channel := self enableChannel.
menu := Menu new.
menu fromLiteralArrayEncoding:(self class menuAlignment).
menu receiver:self.
menu menuItems do:[:anItem| anItem enabled:channel].
^ menu
!
menuPullDown
|menu channel|
channel := self enableChannel.
menu := Menu new.
menu fromLiteralArrayEncoding:(self class menuPullDown).
menu receiver:self.
menu menuItems do:[:anItem|
anItem nameKey ~~ #test ifTrue:[anItem enabled:channel]
ifFalse:[anItem value:channel].
].
^ menu
!
modifiedChannel
|holder|
(holder := builder bindingAt:#modifiedChannel) isNil ifTrue:[
builder aspectAt:#modifiedChannel put:(holder := false asValue).
].
^ holder
!
noteBookView
"automatically generated by UIPainter ..."
|noteBook channel|
(noteBook := builder bindingAt:#noteBookView) isNil ifTrue:[
noteBook := View origin:0.0 @0.0 corner:1.0@1.0.
layoutTool := UIPropertyView for:#Dimension in:noteBook.
specView := UIPropertyView for:#Specification in:noteBook.
channel := self modifiedChannel.
layoutTool modifiedHolder:channel.
specView modifiedHolder:channel.
specView viewBackground:(layoutTool viewBackground).
builder aspectAt:#noteBookView put:noteBook.
].
^ noteBook
!
objectList
^ objectList
!
objectListMenu
"returns a block which returns the menu
!!hack!!
"
^ [ self painter showMiddleButtonMenu ].
!
tabList
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabList) isNil ifTrue:[
builder aspectAt:#tabList put:(holder := ValueHolder new).
].
^ holder
!
tabModel
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabModel) isNil ifTrue:[
lastSlice := 'Basics'.
holder := AspectAdaptor new subject:self; forAspect:#tabSelection.
builder aspectAt:#tabModel put:holder.
].
^ holder
! !
!UIPainter methodsFor:'binding access'!
aspectFor:aKey
"check wether aspect is assigned to a label icon
"
(aKey startsWith:'LABEL') ifFalse:[
^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
].
^ Image fromFile:(aKey copyFrom:(('LABEL' size) + 1))
! !
!UIPainter methodsFor:'change & update'!
update:something with:aParameter from:someObject
(someObject == objectList and:[something ~~ #list]) ifTrue:[
something ~~ #layout ifTrue:[
self objectListChanged
] ifFalse:[
(self modifiedChannel value) ifFalse:[
layoutTool forView:currentView
]
]
]
! !
!UIPainter methodsFor:'event handling'!
doesNotUnderstand:aMessage
|painter|
painter := self painter.
(painter respondsTo:(aMessage selector)) ifTrue:[
^ aMessage sendTo:painter
].
self error
!
objectListChanged
"something changed in the painter view
"
|setSel slices list spec props|
props := objectList selectedProperty.
tabSelection := nil.
props isNil ifFalse:[
currentView := props view.
layoutTool forView:currentView.
spec := props spec copy.
slices := spec class slices.
list := slices collect:[:slice| slice first asString ].
list add:'Dimension'.
(self tabList) value:list.
(list findFirst:[:aName| aName = lastSlice]) ~~ 0 ifTrue:[
setSel := lastSlice
]
] ifTrue:[
layoutTool forView:nil
].
specView specEdited:spec.
self tabModel value:setSel.
! !
!UIPainter methodsFor:'file access'!
openFile:aFileName
|aStream |
aStream := FileStream readonlyFileNamed:aFileName.
aStream notNil ifTrue:[
self painter fileInContentsFrom:aStream.
aStream close.
fileName := aFileName
]
!
saveAs:aFileName
|aStream|
aStream := FileStream newFileNamed:aFileName.
aStream notNil ifTrue:[
self painter storeContentsOn:aStream.
aStream close.
fileName := aFileName
].
! !
!UIPainter methodsFor:'private'!
painter
^ objectList painter
! !
!UIPainter methodsFor:'selection'!
tabSelection
^ tabSelection
!
tabSelection:something
|specEdited slices spec idx|
something isNil ifTrue:[^ self].
tabSelection := something.
(specEdited := specView specEdited) notNil ifTrue:[
slices := specEdited class slices.
lastSlice := tabSelection.
idx:= slices findFirst:[:aSlice| aSlice first = tabSelection ].
idx == 0 ifTrue:[
layoutTool forView:currentView.
^ layoutTool raise.
].
spec := specEdited class perform:((slices at:idx) last).
].
specView raise.
specEdited isNil ifTrue:[
specView buildFromSpec:nil
] ifFalse:[
specView buildFromSpec:spec
]
! !
!UIPainter methodsFor:'startup / release'!
closeRequest
"close all windows open by builder
"
|anyUnsavedChanges|
objectList painter isModified ifTrue:[
(self confirm:'quit without saving ?') ifFalse:[
^ self
]
].
objectList removeDependent:self.
objectList painter release.
objectList := nil.
selectionPanel notNil ifTrue:[
selectionPanel closeRequest
].
super closeRequest.
!
closeRequestFor:aTopView
"handle a close request for a specific view
"
|topView|
topView := self window.
topView == aTopView ifTrue:[
super closeRequestFor:aTopView
] ifFalse:[
topView raise.
topView device beep
].
!
openInterface
"open interfaces
"
|cls painter|
aspects := IdentityDictionary new.
aspects at:#classNameChannel put:(
(specClass notNil ifTrue:[specClass]
ifFalse:['NewApplication']) asValue
).
specSuperclass isNil ifTrue:[
specClass notNil ifTrue:[
(cls := Smalltalk at:specClass asSymbol) notNil ifTrue:[
specSuperclass := cls superclass name.
]
]
].
aspects at:#superclassNameChannel put:(
(specSuperclass notNil ifTrue:[specSuperclass]
ifFalse:['ApplicationModel']) asValue
).
aspects at:#methodNameChannel put:(
(specSelector notNil ifTrue:[specSelector]
ifFalse:[#windowSpec]) asValue
).
painter := UIPainterView new.
painter layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout.
objectList := painter listHolder.
objectList addDependent:self.
super openInterface.
!
openNewWindowCanvas
"open new
"
self open.
!
openOnClass:aClass
"open up an interface builder
"
self openOnClass:aClass andSelector:#windowSpec
!
openOnClass:aClass andSelector:aSelector
"open up an interface builder, fetching a spec from someClass
via some selector
"
|painter|
self openInterface.
painter := self painter.
specClass := aClass name.
specSuperclass := aClass superclass name.
specSelector := aSelector.
painter className:aClass name.
painter methodName:aSelector.
painter setupFromSpec:(aClass perform:aSelector).
!
postOpenWith:aBuilder
"open all subApplications
"
|pview window|
window := self window.
window bePartner.
window label:'Interface Builder'.
window icon:(Image fromFile:'bitmaps/Builder.xbm' resolution:100).
selectionPanel := UISelectionPanel newDefault.
selectionPanel allButOpenInterface:#windowSpec.
selectionPanel window openInGroup:(window windowGroup).
selectionPanel window bePartner.
selectionPanel openWindow.
selectionPanel window application:self.
pview := StandardSystemView new.
pview label:'unnamed canvas'.
pview extent:300@300.
pview add:(self painter).
pview openInGroup:(window windowGroup).
pview bePartner.
pview open.
pview application:self.
! !
!UIPainter methodsFor:'user interaction - dialog'!
browseAppClass
"open a browser on the class"
|cls|
specClass isNil ifTrue:[
self information:'no class yet'.
^ self
].
specClass isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol
] ifTrue:[
cls := specClass
].
cls isNil ifTrue:[
self information:'no class yet'.
^ self
].
SystemBrowser openInClass:cls
!
checkClassAndSelector
"check for class & superclass"
|superclass cls|
specClass isNil ifTrue:[^ false].
specClass isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol
] ifTrue:[
cls := specClass
].
cls isNil ifTrue:[
(superclass := Smalltalk at:specSuperclass asSymbol) isNil ifTrue:[
self warn:'no class named ' , specSuperclass , ' exists.'.
^ false.
].
(self confirm:'create ' , specClass , ' ?') ifTrue:[
superclass subclass:(specClass asSymbol)
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'New-Applications'.
^ true.
].
^ false.
].
cls isBehavior ifFalse:[
self warn:'a global named ' , specClass , ' exists, but is no class.'.
^ false.
].
specSuperclass isBehavior ifFalse:[
superclass := Smalltalk at:specSuperclass asSymbol
] ifTrue:[
superclass := specSuperclass
].
specSuperclass notNil ifTrue:[
superclass isNil ifTrue:[
self warn:'no class named ' , specSuperclass , ' exists.'.
^ false.
].
(cls isSubclassOf:superclass) ifFalse:[
self warn:'a global named ' , specClass , ' exists, but is not a subclass of ' , superclass name , '.'.
^ false.
]
].
^ true
!
defineClassAndSelector
"launch a dialog to define class, superclass and method"
|again|
[
again := false.
(self openDialogInterface:#nameAndSelectorSpec) ifTrue:[
specClass := (self aspectFor:#classNameChannel) value.
specSelector := (self aspectFor:#methodNameChannel) value.
specSuperclass := (self aspectFor:#superclassNameChannel) value.
(again := self checkClassAndSelector not) ifFalse:[
self painter className:specClass
superclassName:specSuperclass
selector:specSelector.
]
]
] doWhile:[again]
! !
!UIPainter methodsFor:'user interaction - pullDown'!
doFromClass
|className methodName cls sel accepted failed spec s painter|
className := '' asValue.
methodName := '' asValue.
painter := self painter.
(s := painter className) notNil ifTrue:[
className value:s
].
(s := painter methodName) notNil ifTrue:[
methodName value:s
].
failed := false.
[
accepted :=
(DialogBox new
addTextLabel:'Classes name:';
addInputFieldOn:className;
addVerticalSpace;
addTextLabel:'methods name:';
addInputFieldOn:methodName;
addAbortButton;
addOkButton;
open
) accepted.
accepted ifTrue:[
cls := Smalltalk classNamed:className value.
cls isNil ifTrue:[
failed := true.
self warn:'no such class'.
] ifFalse:[
sel := methodName value asSymbol.
(cls respondsTo:sel ) ifFalse:[
failed := true.
self warn:'no such method'
] ifTrue:[
spec := cls perform:sel.
spec isArray ifFalse:[
failed := true.
self warn:'not a windowSpec method'
].
"/ ok, got it
painter className:className value.
painter methodName:methodName value.
painter setupFromSpec:spec.
^ self
]
]
]
] doWhile:[accepted and:[failed]].
!
doInstallAspects
|code|
(specClass isNil or:[specSelector isNil]) ifTrue:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
self painter className:specClass
superclassName:specSuperclass
selector:specSelector.
code := self painter generateAspectMethods.
(ReadStream on:code) fileIn.
!
doInstallSpec
|code|
(specClass isNil or:[specSelector isNil]) ifTrue:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
self painter className:specClass
superclassName:specSuperclass
selector:specSelector.
code := self painter generateCode.
(ReadStream on:code) fileIn.
!
doOpen
|box|
box := FileSelectionBox new.
box title:(resources string:'Which file ?').
box selectingDirectory:false.
box pattern:'*.*'.
box action:[:aFile| self openFile:aFile ].
box open
!
doPickAView
|painter view className methodName cls sel accepted spec s|
(view := Display viewFromUser) notNil ifTrue:[
painter := self painter.
spec := UISpecification fromView:view topView.
"/ ok, got it
painter setupFromSpec:spec.
painter className:view class name.
painter methodName:#newSpec.
]
!
doRaise
self painter topView raise.
selectionPanel notNil ifTrue:[
selectionPanel window raise
]
!
doSave
fileName notNil ifTrue:[
self saveAs:fileName
] ifFalse:[
self doSaveAs
]
!
doSaveAs
|box|
box := FileSelectionBox new.
box title:(resources string:'Which file ?').
box selectingDirectory:false.
box pattern:'*.*'.
box action:[:aFile| self saveAs:aFile ].
box open
!
doWindowSpec
|code code2 v|
code := self painter generateWindowSpecMethodSource.
v := CodeView open.
v contents:code.
v label:'windowSpec'.
! !
!UIPainter class methodsFor:'documentation'!
version
^ '$Header$'
! !