"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
ApplicationModel subclass:#UIPainter
instanceVariableNames:'topView workView propertyView treeView elementMenu fileName
specClass specSelector specSuperclass aspects'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
!
HorizontalPanelView subclass:#ButtonPanel
instanceVariableNames:'receiver argumentToSelector'
classVariableNames:''
poolDictionaries:''
privateIn:UIPainter
!
!UIPainter class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
not yet finished, not yet published, not yet released.
[start with:]
UIPainter open
"
! !
!UIPainter class methodsFor:'ST-80 queries'!
preferenceFor:aSymbol
^ false
! !
!UIPainter class methodsFor:'interface specs'!
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'
#'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:' false
#'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
#'acceptOnLostFocus:' true
#'hasBorder:' false
)
#(#InputFieldSpec
#'name:' 'superclassNameField'
#'layout:' #(#LayoutFrame 120 0 90 0 289 0 112 0)
#'model:' #superclassNameChannel
#'tabable:' true
#'immediateAccept:' false
#'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
#'acceptOnLostFocus:' true
#'hasBorder:' false
)
#(#InputFieldSpec
#'name:' 'methodNameField'
#'layout:' #(#LayoutFrame 120 0 130 0 289 0 152 0)
#'model:' #methodNameChannel
#'tabable:' true
#'immediateAccept:' false
#'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
#'acceptOnLostFocus:' 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
)
)
)
)
"Modified: 3.4.1997 / 20:14:32 / cg"
! !
!UIPainter methodsFor:'BuilderView interface'!
update:what
elementMenu deselect.
treeView builderViewChanged:what.
propertyView builderViewChanged:what.
! !
!UIPainter methodsFor:'aspects'!
aspectFor:aKey
^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
! !
!UIPainter methodsFor:'filein & fileout'!
openFile:aFileName
|aStream |
aStream := FileStream readonlyFileNamed:aFileName.
aStream notNil ifTrue:[
workView fileInContentsFrom:aStream.
aStream close.
fileName := aFileName
]
!
saveAs:aFileName
|aStream|
aStream := FileStream newFileNamed:aFileName.
aStream notNil ifTrue:[
workView storeContentsOn:aStream.
aStream close.
fileName := aFileName
].
! !
!UIPainter methodsFor:'help'!
helpTextFor:aComponent
|sel|
(aComponent isKindOf:Button) ifTrue:[
(sel := aComponent changeMessage) notNil ifTrue:[
"/ take the buttons change symbol as resource-key
^ resources string:(sel asString)
]
].
^ nil
"Modified: 31.8.1995 / 20:49:58 / claus"
! !
!UIPainter methodsFor:'initialization'!
createCanvas
|topView|
super initialize.
topView := StandardSystemView new.
topView label:'unnamed'.
topView extent:300@300.
topView application:self.
workView := UIPainterView in:topView.
workView layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout.
^ workView.
"Builder new createCanvas open"
!
initChannels
|cls|
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
).
!
initPullDownMenu:aMenu
aMenu labels:(resources array:#(
'file'
'font'
'type'
'align'
'dimension'
'special'
'misc'
'code'
'test'
)).
aMenu selectors:#(#file
#font
#type
#align
#dimension
#special
#misc
#code
#test
).
aMenu at:#file
putLabels:(resources array:
#('new'
'from class ...'
'pick a view '
'-'
'load'
'save'
'save as ...'
'-'
'install spec'
'install aspects'
'-'
"/ 'source'
'windowSpec'
'inspect me'
'raise'
'-'
'print'
'-'
'quit'
))
selectors:#(doNew
doFromClass
doPickAView
nil
doOpen
doSave
doSaveAs
nil
doInstallSpec
doInstallAspects
nil
"/ doSource
doWindowSpec
inspect
doRaise
nil
doPrint
nil
doFinish
)
receiver:self.
aMenu at:#font putMenu:(workView subMenuFont menuView).
aMenu at:#type
putLabels:(resources array:#(
'basic widgets'
'layout'
'text'
'interactors'
'modal'
'other'
'-'
'all'
) )
selectors:#(showBasicWidgets
showLayoutWidgets
showTextWidgets
showInteractorWidgets
showModalWidgets
showOtherWidgets
nil
showAllWidgets
)
receiver:self.
aMenu at:#align putMenu:(workView subMenuAlign menuView).
aMenu at:#dimension putMenu:(workView subMenuDimension menuView).
aMenu at:#special
putLabels:(resources array:#(
'group radioButtons'
'group enterFields'
) )
selectors:#(
groupRadioButtons
groupEnterFields
)
receiver:workView.
aMenu at:#code
putLabels:(resources array:#(
'class & method'
) )
selectors:#(
defineClassAndSelector
)
receiver:self.
aMenu at:#misc putMenu:(self menuMisc).
aMenu at:#test
putLabels:(resources array:#(
'\c test mode'
) )
selectors:#(doToggleTest
)
receiver:self.
(aMenu menuAt:#test) checkToggleAt:#doToggleTest put:(workView testMode).
!
openInterface
|inset panel menu|
self initChannels.
workView := self createCanvas.
topView := StandardSystemView new.
topView label:'Interface Builder'.
topView icon:(Image fromFile:'bitmaps/Builder.xbm' resolution:100).
topView extent:(600 @ 400).
menu := PullDownMenu in:topView.
panel := ButtonPanel in:topView.
inset := menu preferredExtent y + panel preferredExtent y.
panel origin:0.0@(menu preferredExtent y) corner:1.0@inset .
panel receiver:workView.
elementMenu := HVScrollableView for:SelectionInListView miniScrollerH:true in:topView.
elementMenu origin:0.0@0.0 corner:0.3 @ 1.0.
elementMenu topInset:inset .
elementMenu := elementMenu scrolledView.
elementMenu action:[:selection |
workView testMode ifTrue:[
elementMenu deselect
] ifFalse:[
selection notNil ifTrue:[
workView createWidgetWithClass:
(Smalltalk at:(elementMenu selectionValue asSymbol))
]
]
].
treeView := HVScrollableView for:UIPainterTreeView miniScrollerH:true in:topView.
treeView origin:0.3 @ 0.0 corner:0.6@1.0.
treeView topInset:inset .
treeView := treeView scrolledView.
treeView builderView:workView.
propertyView := View origin:(0.6 @ 0.0) corner:1.0@1.0 in:topView.
propertyView topInset:inset .
propertyView := UIPropertyView in:propertyView builder:workView.
workView addDependent:self.
self initPullDownMenu:menu.
topView application:self.
builder window:topView.
topView beMaster.
workView topView beSlave.
topView open.
workView topView openInGroup:(topView windowGroup).
!
openNewWindowCanvas
self open.
!
openOnClass:aClass andSelector:aSelector
"open up an interface builder, fetching a spec from someClass
via some selector"
|specArray|
specClass := aClass name.
specSuperclass := aClass superclass name.
specSelector := aSelector.
self openInterface.
workView className:aClass name.
workView methodName:aSelector.
workView setupFromSpec:(aClass perform:aSelector).
!
openOnSpec:aSpecOrSpecArray
"open up an interface builder, given some specArray"
|newBuilder|
newBuilder := self new.
! !
!UIPainter methodsFor:'menus'!
menuMisc
|menuView menuGrid menuUndo|
menuView := MenuView labels:
(resources array:#(
'grid'
'undo'
)
)
selectors:#(
#grid
#undo
)
receiver:self.
menuGrid := PopUpMenu labels:(
resources array:#(
'\c show'
'\c align'
)
)
selectors:#(
#gridShown:
#gridAlign:
)
receiver:workView.
menuGrid checkToggleAt:#gridShown: put:(workView gridShown).
menuGrid checkToggleAt:#gridAlign: put:(workView gridAlign).
menuView subMenuAt:#grid put:menuGrid.
menuUndo := PopUpMenu labels:(
resources array:#(
'last'
'menu'
'-'
'delete'
)
)
selectors:#(
#undoLast
#openUndoMenu
nil
#removeUndoHistory
)
receiver:workView.
menuView subMenuAt:#undo put:menuUndo.
^ menuView
! !
!UIPainter methodsFor:'setup choices'!
showAllWidgets
"create list of basic widgets"
self showWidgetsWhere:[:class | true]
!
showBasicWidgets
"create list of basic widgets"
self showWidgetsInCategory:'Views-Basic'
butNot:[:class | class isKindOf:ModalBox class]
!
showInteractorWidgets
"create list of interactor widgets"
self showWidgetsInCategory:'Views-Interactors'
butNot:[:class | class isKindOf:ModalBox class]
!
showLayoutWidgets
"create list of basic widgets"
self showWidgetsInCategory:'Views-Layout'
butNot:[:class | class isKindOf:ModalBox class]
!
showModalWidgets
"create list of modal widgets"
self showWidgetsWhere:[:class | class isKindOf:ModalBox class]
!
showOtherWidgets
"create list of other widgets"
|check cat|
check := [:class |
(#('Views-Basic'
'Views-Interactors'
'Views-Layout'
'Views-Text') includes:class category) not].
self showWidgetsWhere:check
butNot:[:class | class isKindOf:ModalBox class]
!
showTextWidgets
"create list of basic widgets"
self showWidgetsInCategory:'Views-Text'
butNot:[:class | class isKindOf:ModalBox class]
!
showWidgetsInCategory:aCategory
"create list of basic widgets"
self showWidgetsWhere:[:class | class category = aCategory]
!
showWidgetsInCategory:aCategory butNot:excludeBlock
"create list of basic widgets"
self showWidgetsWhere:[:class | class category = aCategory]
butNot:excludeBlock
!
showWidgetsWhere:aBlock
"create list of widgets where aBlock avaluates to true"
self showWidgetsWhere:aBlock butNot:[:class | false]
!
showWidgetsWhere:aBlock butNot:excludeBlock
"create list of widgets where aBlock evaluates to true and excludeBlock
evaluates to false"
|list|
list := OrderedCollection new:0.
SimpleView allSubclassesDo:[:aSubclass |
(aBlock value:aSubclass) ifTrue:[
(excludeBlock value:aSubclass) ifFalse:[
list add:(aSubclass name)
]
]
].
(aBlock value:View) ifTrue:[
(excludeBlock value:View) ifFalse:[
list add:'View'
]
].
(list size == 0) ifFalse:[
list sort
].
elementMenu list:list
! !
!UIPainter methodsFor:'user interaction'!
closeRequest
workView notNil ifTrue:[workView release. workView := nil].
super closeRequest
!
closeRequestFor:aTopView
aTopView == topView ifTrue:[
super closeRequestFor:aTopView
] ifFalse:[
topView device beep
]
! !
!UIPainter methodsFor:'user interaction - dialogs'!
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.
again ifFalse:[
workView className:specClass superclassName:specSuperclass selector:specSelector.
].
]
] doWhile:[again]
! !
!UIPainter methodsFor:'user interaction - menu'!
doFinish
self closeRequest
!
doFromClass
|className methodName cls sel accepted failed spec s|
className := '' asValue.
methodName := '' asValue.
(s := workView className) notNil ifTrue:[
className value:s
].
(s := workView 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
workView className:className value.
workView methodName:methodName value.
workView setupFromSpec:spec.
^ self
]
]
]
] doWhile:[accepted and:[failed]].
"Modified: 5.9.1995 / 18:47:57 / claus"
!
doInstallAspects
|code|
(specClass isNil or:[specSelector isNil]) ifTrue:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
workView className:specClass superclassName:specSuperclass selector:specSelector.
code := workView generateAspectMethods.
(ReadStream on:code) fileIn.
"Modified: 4.9.1995 / 17:06:10 / claus"
!
doInstallSpec
|code|
(specClass isNil or:[specSelector isNil]) ifTrue:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
workView className:specClass superclassName:specSuperclass selector:specSelector.
code := workView generateCode.
(ReadStream on:code) fileIn.
"Modified: 4.9.1995 / 17:06:10 / claus"
!
doNew
workView removeAll.
!
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
|view className methodName cls sel accepted spec s|
view := Display viewFromUser.
view isNil ifTrue:[^ self].
spec := UISpecification fromView:view topView.
"/ ok, got it
workView setupFromSpec:spec.
workView className:view class name.
workView methodName:#newSpec.
^ self
"Modified: 5.9.1995 / 23:25:53 / claus"
!
doPrint
^ self
!
doRaise
workView topView 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
!
doSource
|code v|
code := workView generateCode.
v := CodeView open.
v contents:code.
v label:(workView applicationName).
^ self
"Modified: 5.9.1995 / 21:02:05 / claus"
!
doToggleTest
workView testMode:(workView testMode not)
!
doWindowSpec
|code code2 v|
code := workView generateWindowSpecMethodSource.
"/ code2 := workView generateAspectMethods.
code2 notNil ifTrue:[
code := code , code2.
].
v := CodeView open.
v contents:code.
v label:'windowSpec'.
^ self
"Modified: 5.9.1995 / 21:04:14 / claus"
! !
!UIPainter::ButtonPanel class methodsFor:'documentation'!
version
^ '$Header$'
! !
!UIPainter::ButtonPanel methodsFor:'accessing'!
receiver
^ receiver
!
receiver:aReceiver
receiver := aReceiver
! !
!UIPainter::ButtonPanel methodsFor:'initialization'!
initialize
"initialize and setup buttons
"
super initialize.
self level:-1.
self borderWidth:0.
self horizontalLayout:#leftSpace.
argumentToSelector := 1.
self specification do:[:anArray|
|selector image button seperator|
selector := anArray at:1.
selector notNil ifTrue:[
image := Image fromFile:( anArray at:2 ).
button := Button label:image in:self.
selector last == $: ifFalse:[
button action:[
receiver notNil ifTrue:[
receiver perform:selector
]
]
] ifTrue:[
button pressAction:[
receiver notNil ifTrue:[
receiver perform:selector with:argumentToSelector
].
receiver enableUndoHistory:false.
].
button releaseAction:[ receiver enableUndoHistory:true ].
button autoRepeat:true.
button menuHolder:self; menuMessage:#editMenu; menuPerformer:self.
]
] ifFalse:[
seperator := View in:self.
seperator extent:20@1.
seperator borderWidth:0.
]
].
!
specification
"return a spec for the buttons in the panel;
entries consists of selector and bitmap-filename.
nil selectors are taken as separators (see setupButtonPanel)"
^ #(
#( alignSelectionLeft 'b_alignL.xbm' )
#( alignSelectionRight 'b_alignR.xbm' )
#( alignSelectionLeftAndRight 'b_alignLR.xbm' )
#( nil )
#( alignSelectionTop 'b_alignT.xbm' )
#( alignSelectionBottom 'b_alignB.xbm' )
#( alignSelectionTopAndBottom 'b_alignTB.xbm' )
#( nil )
#( alignSelectionCenterHor 'b_alignCH.xbm' )
#( alignSelectionCenterVer 'b_alignCV.xbm' )
#( nil )
#( moveSelectionLeft: 'b_moveLeft.xbm' )
#( moveSelectionRight: 'b_moveRight.xbm' )
#( moveSelectionUp: 'b_moveUp.xbm' )
#( moveSelectionDown: 'b_moveDown.xbm' )
)
! !
!UIPainter::ButtonPanel methodsFor:'menu'!
editMenu
"edit menu used by buttons using an argument for the receiver; the argumentToSelector
"
|menu|
menu := PopUpMenu labels:#( '1' '2' '4' '10' '20' '..' )
args:#( 1 2 4 10 20 nil ).
menu action:[:anArg||no|
(no := anArg) isNil ifTrue:[
no := EnterBox request:'number'.
no := SmallInteger readFrom:no onError:0.
].
no ~~ 0 ifTrue:[
|index view|
view := (WindowGroup lastEventQuerySignal raise) view.
view := view menuPerformer.
argumentToSelector := no.
view pressAction value.
argumentToSelector := 1.
]
].
^ menu
! !
!UIPainter::ButtonPanel methodsFor:'queries'!
specClass
^ HorizontalPanelViewSpec
! !
!UIPainter class methodsFor:'documentation'!
version
^ '$Header$'
! !