"
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.
"
'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:29 pm' !
UIObjectView subclass:#UIPainterView
instanceVariableNames:'fontPanel viewProperties superclassName className methodName
categoryName'
classVariableNames:'HandCursor'
poolDictionaries:''
category:'Interface-UIPainter'
!
Object subclass:#ViewProperty
instanceVariableNames:'aspectSelector changeSelector nameIndex view elementClass
labelSelector identifier tabable defaultable menuSelector
initiallyInvisible'
classVariableNames:'Identifier'
poolDictionaries:''
privateIn:UIPainterView
!
UIPainterView::ViewProperty subclass:#GroupProperties
instanceVariableNames:'controlledObjects group'
classVariableNames:''
poolDictionaries:''
privateIn:UIPainterView
!
!UIPainterView 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.
"
! !
!UIPainterView class methodsFor:'defaults'!
defaultMenuMessage
"This message is the default yo be sent to the menuHolder to get a menu
"
^ #menu
! !
!UIPainterView methodsFor:'accessing'!
application
self halt.
^ nil
"Modified: 6.9.1995 / 00:46:44 / claus"
!
className
^ className
"Modified: 5.9.1995 / 18:41:30 / claus"
!
className:aString
className := aString
"Modified: 5.9.1995 / 18:47:17 / claus"
!
className:aClassName superclassName:aSuperclassName selector:aSelector
className := aClassName.
superclassName := aSuperclassName.
methodName := aSelector.
!
methodName
^ methodName
"Modified: 5.9.1995 / 18:41:34 / claus"
!
methodName:aString
methodName := aString
"Modified: 5.9.1995 / 18:47:27 / claus"
!
selectNames:aStringOrCollection
|prop coll s|
(aStringOrCollection isNil or:[aStringOrCollection isEmpty]) ifTrue:[
^ self unselect
].
(s := aStringOrCollection) isString ifFalse:[
s size == 1 ifTrue:[
s := s first
] ifFalse:[
coll := OrderedCollection new.
s do:[:aName|
(prop := self propertyOfName:aName) notNil ifTrue:[
coll add:(prop view)
]
].
coll size == 1 ifTrue:[ ^ self select:(coll at:1) ].
coll size == 0 ifTrue:[ ^ self unselect ].
^ self select:coll.
]
].
prop := self propertyOfName:s.
prop isNil ifTrue:[^ self unselect]
ifFalse:[^ self select:(prop view)]
! !
!UIPainterView ignoredMethodsFor:'code manipulation'!
changeClass
|box classNameHolder superclassNameHolder|
classNameHolder := (className ? 'MyClass') asValue.
superclassNameHolder := (superclassName ? 'ApplicationModel') asValue.
box := DialogBox new.
box addTextLabel:'class:'.
box addInputFieldOn:classNameHolder.
box addTextLabel:'super class:'.
box addInputFieldOn:superclassNameHolder.
box addAbortButton; addOkButton.
box open.
box accepted ifTrue:[
className := classNameHolder value.
superclassName := superclassNameHolder value.
].
!
changeVariables
| box names propList p n newName|
names := VariableArray new.
propList := VariableArray new.
viewProperties do:[:props |
n := props name.
n notNil ifTrue:[
names add:n.
propList add:props
]
].
box := BuilderVariablesBox new.
box list:names.
box selectAction:[:selection |
p := propList at:selection
].
box okAction:[
newName := box enterValue.
Transcript showCR:('renamed ' , (p name) , 'to:' , newName).
p name:newName
].
box showAtPointer
! !
!UIPainterView methodsFor:'copy & cut & paste'!
copySelection
"copy the selection into the cut&paste-buffer
"
|specs|
specs := self generateSpecFor:selection.
specs notNil ifTrue:[
self setSelection:specs
].
self unselect.
!
deleteSelection
"delete the selection; not into the paste buffer (undo)
"
|text|
self numberOfSelections ~~ 0 ifTrue:[
text := self transactionTextFor:selection.
undoHistory transaction:#cut text:text do:[
super deleteSelection
].
]
!
pasteBuffer
"add the objects in the paste-buffer
"
|paste builder frame pasteOrigin pasteOffset|
paste := self getSelection.
(self canPaste:paste) ifFalse:[ ^ self].
(paste isCollection) ifFalse:[ paste := Array with:paste].
frame := self singleSelection.
(self supportsSubComponents:frame) ifFalse:[
frame := self
].
self unselect.
builder := UIBuilder new.
selection := OrderedCollection new.
pasteOffset := 0@0.
pasteOrigin := self sensor mousePoint.
pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id.
paste do:[:aSpec|
|view org|
builder componentCreationHook:[:aView :aSpecification :aBuilder |
self createdComponent:aView forSpec:aSpecification builder:aBuilder.
].
builder applicationClass:(Smalltalk classNamed:className).
view := aSpec buildViewWithLayoutFor:builder in:frame.
(frame bounds containsPoint:pasteOrigin) ifFalse:[
self moveObject:view to:pasteOffset.
] ifTrue:[
self moveObject:view to:pasteOrigin + pasteOffset.
].
view realize.
selection add:view.
pasteOffset := pasteOffset + 4.
].
self transaction:#paste selectionDo:[:v|
self undoCreate:((self propertyOfView:v) identifier)
].
selection size == 1 ifTrue:[
selection := selection at:1
].
self showSelection.
self realizeAllSubViews.
inputView raise.
self changed:#tree
! !
!UIPainterView methodsFor:'creating subviews'!
addProperties:properties for:aView
"set properties to a view and add properties to viewProperties.
In case that properties are nil properties are created
"
|name props|
(props := properties) isNil ifTrue:[
props := self propertiesForNewView:aView.
].
viewProperties add:props.
name := props name.
aView specClass basicNew supportsLabel ifTrue:[
aView label:name
].
aView name:name.
^ props
!
propertiesForNewView:aView
|cls props index|
cls := aView class.
props := ViewProperty new.
props view:aView.
props elementClass:cls.
index := self variableIndexForClass:cls.
props nameIndex:index.
props name:(self variableNameForClass:cls index:index).
^ props
!
setupCreatedObject:anObject
"set default properties for a created object
"
|props|
props := self addProperties:nil for:anObject.
undoHistory transaction:#create text:(props name) do:[
self undoCreate:(props identifier).
].
! !
!UIPainterView methodsFor:'drag & drop'!
canDrop:anObjectOrCollection
Transcript showCR:'canDrop'.
^ true
!
drop:anObjectOrCollection at:aPoint
Transcript showCR:'drop:anObjectOrCollection at:aPoint'.
! !
!UIPainterView methodsFor:'event handling'!
keyPress:key x:x y:y
<resource: #keyboard ( #Copy #Paste) >
key == #Copy ifTrue:[
^ self copySelection
].
key == #Paste ifTrue:[
^ self pasteBuffer
].
super keyPress:key x:x y:y
! !
!UIPainterView methodsFor:'generating output'!
generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
^ ('!!' , targetClass name , ' methodsFor:''actions''!!\\' ,
aspect , '\' ,
' "automatically generated by UIPainter ..."\' ,
'\' ,
' "action to be added ..."\' ,
' Transcript showCR:''action for ' , aspect , ' ...''.\' ,
'!! !!\\') withCRs
!
generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
^ ('!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,
aspect , '\' ,
' "automatically generated by UIPainter ..."\' ,
'\' ,
' |holder|\' ,
'\' ,
' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
' builder aspectAt:#' , aspect , ' put:(holder := ' , ' ValueHolder new' , ').\' ,
' ].\' ,
' ^ holder\' ,
'!! !!\\') withCRs
!
generateAspectMethods
|cls code|
className isNil ifTrue:[
^ self warn:'set the class first'
].
(cls := Smalltalk at:className asSymbol) isNil ifTrue:[
^ self warn:'create the class first'
].
code := ''.
viewProperties do:[:aProp |
|modelSelector protoSpec thisCode|
(modelSelector := aProp aspectSelector) notNil ifTrue:[
(cls implements:modelSelector asSymbol) ifFalse:[
protoSpec := aProp view specClass basicNew.
"/ kludge ..
(protoSpec isMemberOf:ActionButtonSpec) ifTrue:[
thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls).
] ifFalse:[
thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls).
].
code := code , thisCode
]
]
].
^ code
! !
!UIPainterView ignoredMethodsFor:'generating output'!
generateClassDefinition
|defCode|
defCode := superclassName , ' subclass:#' , className , '\'.
defCode := defCode , ' instanceVariableNames:'''.
defCode := defCode , self subviewVariableNames , '''\'.
defCode := defCode , ' classVariableNames:''''\'.
defCode := defCode , ' poolDictionaries:''''\'.
defCode := defCode , ' category:''' , categoryName , '''\'.
defCode := defCode , Character excla asString , '\\'.
^ defCode withCRs
! !
!UIPainterView methodsFor:'generating output'!
generateCode
"generate code for the windowSpec method"
|code|
code := ''.
"/ (Smalltalk classNamed:className asSymbol) isNil ifTrue:[
"/ code := code , self generateClassDefinition.
"/ ].
"/ code := code , self generateInitMethod.
code := code , self generateWindowSpecMethodSource.
"/ code := code , self generateAspectMethods.
^ code withCRs
"Modified: 5.9.1995 / 20:57:53 / claus"
! !
!UIPainterView ignoredMethodsFor:'generating output'!
generateInitCodeForGroup:aGroup
|code c name p objects outlets moreCode sym typ val|
" <name> := <GroupClass> in:<name-of-superview>"
code := ''.
p := self propertyOfGroup:aGroup.
name := p at:#variableName.
c := ' ' , name , ' := ' , (aGroup class name) , ' new.\'.
code := code , c withCRs.
" <name> <symbol>:<value>"
objects := p at:#controlledObjects ifAbsent:[nil].
objects notNil ifTrue:[
objects do:[:controlledObject |
c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\'
]
].
code := code , c withCRs
!
generateInitCodeForOtherStuff
|code g c name p outlets moreCode sym typ val|
code := ''.
"generate code for groups"
viewProperties do:[:props |
g := props at:#group ifAbsent:[nil].
g notNil ifTrue:[
code := code , (self generateInitCodeForGroup:g)
]
].
^ code
!
generateInitCodeForView:aView
|code c name p outlets moreCode sym typ val|
" <name> := <ViewClass> in:<name-of-superview>"
code := ''.
p := self propertyOfView:aView.
name := p at:#variableName.
c := ' ' , name , ' := ' ,
(aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'.
" <name> origin:(...) extent:(...)"
c := c , ' ' , name , ' origin:(', aView origin printString , ')'
, ' extent:(', aView extent printString , ').\'.
moreCode := p at:#initCode ifAbsent:nil.
moreCode notNil ifTrue:[
c := c , moreCode , '\' withCRs
].
code := code , c withCRs.
" <name> <symbol>:<value>"
outlets := p at:#outlets ifAbsent:[nil].
outlets notNil ifTrue:[
outlets do:[:selectorOutlet |
sym := selectorOutlet at:#selector.
typ := selectorOutlet at:#type.
val := selectorOutlet at:#value.
c := ' ' , name , ' ' , sym.
(typ == #number) ifTrue:[
c := c , val printString
].
(typ == #string) ifTrue:[
c := c , '''' , val , ''''
].
(typ == #text) ifTrue:[
c := c , '''' , val asString , ''''
].
(typ == #strings) ifTrue:[
c := c , '#( '.
val asText do:[:aString |
c := c , '''' , aString , ''' '
].
c := c , ')'
].
(typ == #block) ifTrue:[
c := c , val
].
(typ == #color) ifTrue:[
c := c , '(Color name:''' , val , ''')'
].
c := c , '.' , Character cr asString.
code := code , c
]
].
self subviewsOf:aView do:[:v |
code := code , (self generateInitCodeForView:v)
].
^ code.
"Modified: 5.9.1995 / 20:06:07 / claus"
!
generateInitMethod
|defCode code|
defCode := Character excla asString ,
className , ' methodsFor:''initialization''' ,
Character excla asString , '\\'.
defCode := defCode , 'initialize\'.
defCode := defCode , ' super initialize.\'.
defCode := defCode , ' self setupSubViews.\'.
defCode := defCode , ' self setupLocalStuff\'.
defCode := defCode , Character excla asString , '\\'.
defCode := defCode , 'setupSubViews\'.
code := defCode withCRs.
self subviewsOf:self do:[:v |
code := code , (self generateInitCodeForView:v)
].
code := code , (self generateInitCodeForOtherStuff).
code := code , ' ^ self\' withCRs.
defCode := Character excla asString , '\\'.
defCode := defCode , 'setupLocalStuff\'.
defCode := defCode , ' ^ self\'.
defCode := defCode , Character excla asString , ' ' ,
Character excla asString , '\\'.
code := code , defCode withCRs.
^ code.
!
generateOutlets
^ self
! !
!UIPainterView methodsFor:'generating output'!
generateSpecFor:something
"generate a spec for a view or collection of views
"
|spec views|
something notNil ifTrue:[
something isCollection ifTrue:[views := something]
ifFalse:[views := Array with:something].
spec := views collect:[:aView||topSpec|
aView specClass isNil ifTrue:[
^ nil
].
topSpec := aView specClass
fromView:aView
callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
topSpec
]
].
^ spec
!
generateWindowSpecMethodSource
|spec specArray str code|
subViews remove:inputView.
[
spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
] valueNowOrOnUnwindDo:[
subViews addFirst:inputView.
].
specArray := spec literalArrayEncoding.
str := WriteStream on:String new.
self prettyPrintSpecArray:specArray on:str indent:5.
code := Character excla asString
, className , ' class methodsFor:''interface specs'''
, Character excla asString , '\\'
, methodName , '\'
, ' "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:' , className , ' andSelector:#' , methodName , '\'
, ' ' , className , ' new openInterface:#' , methodName , '\'
, ' "\'.
methodName = 'windowSpec' ifTrue:[
code := code , ' "' , className , ' open"\'
].
code := code
, '\'
, ' <resource: #canvas>\\'
, ' ^\'
, ' ', str contents
, '\'
, Character excla asString
, ' '
, Character excla asString
, '\\'.
^ code withCRs
"Modified: 5.9.1995 / 21:01:35 / claus"
! !
!UIPainterView ignoredMethodsFor:'generating output'!
nameOfClass
^ 'NewView'
! !
!UIPainterView methodsFor:'generating output'!
outletValueOf:aSymbol for:aView
"/ |c name p outlets moreCode sym typ val|
"/
"/ p := self propertyOfView:aView.
"/ outlets := p at:#outlets ifAbsent:[^ nil].
"/ outlets notNil ifTrue:[
"/ outlets do:[:selectorOutlet |
"/ sym := selectorOutlet at:#selector.
"/ (sym == aSymbol) ifTrue:[
"/ typ := selectorOutlet at:#type.
"/ val := selectorOutlet at:#value.
"/ ^ val
"/ ]
"/ ]
"/ ].
^ nil
!
prettyPrintSpecArray:spec on:aStream indent:i
"just for your convenience: prettyPrint a specArray to aStream - it looks better that way"
|what oneLine|
spec isArray ifFalse:[
spec isLiteral ifTrue:[
aStream nextPutAll:spec storeString
] ifFalse:[
self halt.
].
^ self
].
spec isEmpty ifTrue:[
aStream nextPutAll:'#()'.
^ self
].
what := spec at:1.
what isArray ifTrue:[
aStream cr; spaces:i+2.
aStream nextPutAll:'#('.
"/ a spec-collection
spec do:[:element |
self prettyPrintSpecArray:element on:aStream indent:i+2.
].
aStream cr.
aStream spaces:i+1.
aStream nextPutAll:')'.
^ self.
].
oneLine := false.
(#(#LayoutFrame #LayoutOrigin #AlignmentOrigin
#Rectangle #Point
#Color #ColorValue
)
includesIdentical:what) ifTrue:[
oneLine := true
].
oneLine ifFalse:[
aStream cr.
aStream spaces:i+2.
].
aStream nextPutAll:'#('.
aStream nextPutAll:what storeString.
oneLine ifFalse:[
aStream cr.
aStream spaces:i+4.
].
2 to:spec size do:[:index |
aStream space.
self prettyPrintSpecArray:(spec at:index) on:aStream indent:i+4.
oneLine ifFalse:[
(index odd and:[index ~~ (spec size)]) ifTrue:[
aStream cr; spaces:i+4.
]
]
].
oneLine ifFalse:[
aStream cr.
aStream spaces:i+1.
].
aStream nextPutAll:')'.
"Modified: 5.9.1995 / 17:44:20 / claus"
!
storeContentsOn:aStream
viewProperties do:[:p| p storeOn:aStream]
!
stuffPropertiesFrom:view intoSpec:newSpec
"stuff any additional information (held in the properties) into the spec
which was just created from view"
|props aspectSelector changeSelector labelSelector name tabable defaultable
menuSelector initiallyInvisible|
props := self propertyOfView:view.
props isNil ifTrue:[^ self].
(aspectSelector := props aspectSelector) notNil ifTrue:[
newSpec model:aspectSelector
].
(changeSelector := props changeSelector) notNil ifTrue:[
newSpec change:changeSelector
].
(menuSelector := props menuSelector) notNil ifTrue:[
newSpec menu:menuSelector
].
(labelSelector := props labelSelector) notNil ifTrue:[
newSpec label:labelSelector
].
(tabable := props tabable) notNil ifTrue:[
newSpec tabable:tabable
].
(defaultable := props defaultable) notNil ifTrue:[
newSpec defaultable:defaultable
].
(initiallyInvisible := props initiallyInvisible) notNil ifTrue:[
newSpec initiallyInvisible:initiallyInvisible
].
(name := props name) notNil ifTrue:[
newSpec name:name
].
! !
!UIPainterView ignoredMethodsFor:'generating output'!
subviewVariableNames
|names|
names := ''.
viewProperties do:[:p| names := names , ' ' , (p name)].
^ names
! !
!UIPainterView methodsFor:'generating output'!
subviewsOf:aView do:aBlock
|subs v|
(subs := aView subViews) notNil ifTrue:[
subs do:[:v|
(v ~~ inputView and:[v notNil]) ifTrue:[
(viewProperties detect:[:p | p view == v] ifNone:nil) notNil ifTrue:[
(v superView == aView) ifTrue:[
aBlock value:v
]
]
]
]
]
! !
!UIPainterView methodsFor:'group manipulations'!
groupEnterFields
|props name index group objects|
selection isNil ifTrue:[^ self].
self selectionDo:[:aView |
(aView isKindOf:EditField) ifFalse:[
self warn:'select EditFields only !!'.
^ self
]
].
self selectionHiddenDo:[
group := EnterFieldGroup new.
props := GroupProperties new.
props elementClass:EnterFieldGroup.
props group:group.
index := self variableIndexForClass:EnterFieldGroup.
props nameIndex:index.
name := self variableNameForClass:EnterFieldGroup index:index.
props name:name.
objects := OrderedCollection new.
props controlledObjects:objects.
viewProperties add:props.
self selectionDo:[:aView |
objects add:aView.
group add:aView
].
]
!
groupRadioButtons
|props name index group objects|
selection isNil ifTrue:[^ self].
self selectionDo:[:aView |
(aView isKindOf:RadioButton) ifFalse:[
self warn:'select RadioButtons only !!'.
^ self
]
].
self selectionHiddenDo:[
group := RadioButtonGroup new.
props := GroupProperties new.
props elementClass:RadioButtonGroup.
props group:group.
index := self variableIndexForClass:RadioButtonGroup.
props nameIndex:index.
name := self variableNameForClass:RadioButtonGroup index:index.
props name:name.
group groupID:name asSymbol.
objects := OrderedCollection new.
props controlledObjects:objects.
viewProperties add:props.
self selectionDo:[:aView |
aView turnOff.
objects add:aView.
group add:aView
].
]
"Modified: 5.9.1995 / 16:06:15 / claus"
! !
!UIPainterView methodsFor:'initialization'!
initialize
super initialize.
superclassName := 'ApplicationModel'.
className := 'NewApplication'.
methodName := 'windowSpec'.
categoryName := 'Applications'.
viewProperties := OrderedCollection new.
HandCursor := Cursor leftHand.
"Modified: 5.9.1995 / 19:58:06 / claus"
! !
!UIPainterView methodsFor:'interface to Builder'!
addOutletDefinitionFor:outletSymbol type:type value:outletValue for:aView
|outletProps selectorProps viewProps|
viewProps := self propertyOfView:aView.
"/ outletProps := viewProps at:#outlets ifAbsent:[nil].
"/ outletProps isNil ifTrue:[
"/ outletProps := Dictionary new.
"/ viewProps at:#outlets put:outletProps
"/ ].
"/ selectorProps := outletProps at:outletSymbol ifAbsent:[nil].
"/ selectorProps isNil ifTrue:[
"/ selectorProps := Dictionary new.
"/ outletProps at:outletSymbol put:selectorProps
"/ ].
"/
"/ selectorProps at:#selector put:outletSymbol.
"/ selectorProps at:#type put:type.
"/ selectorProps at:#value put:outletValue
!
addSpec:specOrSpecArray
|spec builder|
spec := UISpecification from:specOrSpecArray.
builder := UIBuilder new.
builder componentCreationHook:[:view :spec :aBuilder |
self createdComponent:view forSpec:spec builder:aBuilder
].
builder applicationClass:(Smalltalk classNamed:className).
spec setupView:self for:builder.
self realizeAllSubViews.
inputView raise.
"/ viewProperties := OrderedCollection new.
"/ self generatePropertiesFor:(self subViews select:[:v | v ~~ inputView]).
self changed:#tree.
"Modified: 5.9.1995 / 23:36:55 / claus"
!
applicationName
^ className
!
aspectAt:aSymbol
self halt.
^ nil
"Modified: 6.9.1995 / 00:45:35 / claus"
!
createdComponent:newView forSpec:aSpec builder:aBuilder
"callBack from UISpec view building"
|props|
props := self propertiesForNewView:newView.
aSpec name notNil ifTrue:[
(self propertyOfName:(aSpec name)) isNil ifTrue:[
props name:aSpec name
]
].
props labelSelector:(aSpec labelSelector).
props aspectSelector:(aSpec modelSelector).
props menuSelector:(aSpec menuSelector).
props tabable:(aSpec tabable).
props defaultable:(aSpec defaultable).
props initiallyInvisible:(aSpec initiallyInvisible).
viewProperties add:props.
!
generatePropertiesFor:aCollectionOfViews
"/ done as two loops, to get bread-first naming
aCollectionOfViews do:[:aView|
|props|
props := self propertiesForNewView:aView.
viewProperties add:props.
aView name:(props name).
aView geometryLayout isNil ifTrue:[
aView geometryLayout:(aView bounds asLayout).
]
].
aCollectionOfViews do:[:aView |
|subs|
subs := aView subViews.
subs notNil ifTrue:[
self generatePropertiesFor:subs
]
].
!
inspectAttributes
|p|
self singleSelectionDo:[:aView |
p := self propertyOfView:aView.
p inspect
]
!
inspectSpec
|s|
self singleSelectionDo:[:aView |
s := self generateSpecFor:aView.
s first inspect
]
!
setupFromSpec:specOrSpecArray
self removeAll.
self addSpec:specOrSpecArray
!
showFontPanel
|action|
fontPanel isNil ifTrue:[
fontPanel := FontPanel new
].
selection notNil ifTrue:[
action := [:family :face :style :size |
self changeFontFamily:family face:face
style:style size:size
].
fontPanel action:action.
fontPanel showAtPointer
]
! !
!UIPainterView methodsFor:'menus'!
menu
|menu canPaste|
testMode ifTrue:[^ nil ].
canPaste := self canPaste:(self getSelection).
selection isNil ifTrue:[
menu := PopUpMenu labels:( resources array:#('paste' 'undo'))
selectors:#( #pasteBuffer #undoLast )
accelerators:#( #Paste nil )
receiver:self.
canPaste ifFalse:[menu disable:#pasteBuffer].
undoHistory isEmpty ifTrue:[menu disable:#undoLast].
^ menu
].
menu := PopUpMenu labels:( resources array:#(
'copy'
'cut'
'paste'
'-'
'arrange'
'dimension'
'align'
)
)
selectors:#( #copySelection
#deleteSelection
#pasteBuffer
nil
#arrange
#dimension
#align
)
accelerators:#(#Copy
#Cut
#Paste
nil
nil
nil
nil
)
receiver:self.
(canPaste and:[self supportsSubComponents:selection]) ifFalse:[
menu disable:#pasteBuffer
].
menu subMenuAt:#arrange put:(self subMenuArrange).
menu subMenuAt:#dimension put:(self subMenuDimension).
menu subMenuAt:#align put:(self subMenuAlign).
^ menu
!
subMenuAlign
"returns submenu alignment
"
|menu|
menu := PopUpMenu labels:(
resources array:#(
'align left'
'align right'
'align left & right'
'align top'
'align bottom'
'align centered vertical'
'align centered horizontal'
'-'
'spread horizontal'
'spread vertical'
'center horizontal in frame'
'center vertical in frame'
)
)
selectors:#(
alignSelectionLeft
alignSelectionRight
alignSelectionLeftAndRight
alignSelectionTop
alignSelectionBottom
alignSelectionCenterHor
alignSelectionCenterVer
nil
spreadSelectionHor
spreadSelectionVer
centerSelectionHor
centerSelectionVer
)
receiver:self.
^ menu
!
subMenuArrange
"returns submenu arrange
"
|menu|
menu := PopUpMenu labels:(
resources array:#(
'to front'
'to back'
)
)
selectors:#(
raiseSelection
lowerSelection
)
receiver:self.
^ menu
!
subMenuDimension
"returns submenu dimension
"
|menu|
menu := PopUpMenu labels:(
resources array:#(
'default extent'
'default width'
'default height'
'-'
'copy extent'
'-'
'paste extent'
'paste width'
'paste height'
)
)
selectors:#(
setToDefaultExtent
setToDefaultWidth
setToDefaultHeight
nil
copyExtent
nil
pasteExtent
pasteWidth
pasteHeight
)
receiver:self.
^ menu
!
subMenuFont
"returns submenu dimension
"
|menu|
menu := PopUpMenu labels:(
resources array:#(
'larger'
'smaller'
'-'
'normal'
'bold'
'italic'
'bold italic'
'-'
'font panel'
)
)
selectors:#(
largerFont
smallerFont
nil
normalFont
boldFont
italicFont
boldItalicFont
nil
showFontPanel
)
receiver:self.
^ menu
! !
!UIPainterView methodsFor:'misc'!
changeFontFamily:family face:face style:style size:size
|f|
f := Font family:family
face:face
style:style
size:size.
f notNil ifTrue:[
self selectionHiddenDo:[
self selectionDo:[:aView |
aView font:f.
self elementChanged:aView.
]
]
]
"Modified: 5.9.1995 / 12:13:27 / claus"
!
changeVariableNameOf:aView to:newName
|prop|
prop := self propertyOf:aView.
prop isNil ifTrue:[
^ self error:'no such view'
].
((aView respondsTo:#label:) and:[aView label = prop name]) ifTrue:[
self selectionHiddenDo:[
|layout|
layout := aView geometryLayout copy.
aView label:newName.
aView geometryLayout:layout.
]
].
prop name:newName.
aView name:newName.
self changed:#widgetName
!
variableIndexForClass:aClass
|max|
max := 0.
viewProperties do:[:p|
p elementClass == aClass ifTrue:[
max := max max:(p nameIndex)
]
].
^ max + 1
!
variableNameForClass:aClass index:index
|n|
n := (aClass name) , index printString.
n at:1 put:(n at:1) asLowercase.
^ n
!
variableNameOf:aView
|prop|
aView notNil ifTrue:[
prop := self propertyOf:aView
].
prop notNil ifTrue:[^ prop name]
ifFalse:[^ 'self']
! !
!UIPainterView methodsFor:'removing components'!
remove:something
"remove something, anObject or a collection of objects from the contents do redraw
"
self forEach:something do:[:anObject |
self removeObject:anObject
]
!
removeAll
"remove the argument, anObject"
self unselect.
subViews notNil ifTrue:[
subViews copy do:[:sub |
sub ~~ inputView ifTrue:[
self removeTreeFrom:sub
]
]
].
viewProperties := OrderedCollection new.
undoHistory reinitialize.
self changed:#tree
!
removeObject:anObject
"remove the argument, anObject
"
|spec prop|
undoHistory isTransactionOpen ifTrue:[
(prop := self propertyOfView:anObject) notNil ifTrue:[
self undoRemove:(prop identifier)
]
].
self removeTreeFrom:anObject.
self changed:#tree
!
removeTreeFrom:anObject
"remove the argument, anObject and all of its children
"
|props|
anObject notNil ifTrue:[
(anObject subViews notNil) ifTrue:[
anObject subViews copy do:[:sub |
self removeTreeFrom:sub
]
].
props := self propertyOf:anObject.
props notNil ifTrue:[
viewProperties remove:props ifAbsent:nil
].
anObject destroy
]
! !
!UIPainterView methodsFor:'searching'!
findObjectAt:aPoint
"find the origin/corner of the currentWidget
"
|view|
view := super findObjectAt:aPoint.
view notNil ifTrue:[
"can be a view within a view not visible
"
[ (self propertyOfView:view) isNil ] whileTrue:[
(view := view superView) == self ifTrue:[^ nil]
]
].
^ view
!
findViewWithId:aViewId
"finds view assigned to id and returns the view or nil
"
|prop|
prop := self propertyOfIdentifier:aViewId.
prop notNil ifTrue:[^ prop view]
ifFalse:[^ nil]
! !
!UIPainterView methodsFor:'seraching property'!
propertyOf:something
^ viewProperties detect:[:p| (p view == something or:[p group == something])]
ifNone:nil
!
propertyOfGroup:aGroup
^ viewProperties detect:[:p| p group == aGroup] ifNone:nil
!
propertyOfIdentifier:anId
anId notNil ifTrue:[
^ viewProperties detect:[:p| p identifier == anId] ifNone:nil.
].
^ nil
!
propertyOfName:aString
aString = 'self' ifFalse:[
^ viewProperties detect:[:p| p name = aString] ifNone:nil
].
^ nil
!
propertyOfView:aView
(aView isNil or:[aView == self]) ifFalse:[
^ viewProperties detect:[:p| p view == aView] ifNone:nil
].
^ nil
! !
!UIPainterView methodsFor:'testing'!
isHorizontalResizable:aComponent
(aComponent isKindOf:ScrollBar) ifTrue:[
^ aComponent orientation == #horizontal
].
(aComponent isKindOf:Scroller) ifTrue:[
^ aComponent orientation == #horizontal
].
(aComponent isKindOf:Slider) ifTrue:[
^ aComponent orientation == #horizontal
].
^ true
!
isVerticalResizable:aComponent
(aComponent isKindOf:EditField) ifTrue:[
^ false
].
(aComponent isKindOf:ComboBoxView) ifTrue:[
^ false
].
(aComponent isKindOf:CheckBox) ifTrue:[
^ false
].
(aComponent isKindOf:ScrollBar) ifTrue:[
^ aComponent orientation == #vertical
].
(aComponent isKindOf:Scroller) ifTrue:[
^ aComponent orientation == #vertical
].
(aComponent isKindOf:Slider) ifTrue:[
^ aComponent orientation == #vertical
].
^ true
! !
!UIPainterView methodsFor:'transaction'!
transaction:aType objects:something do:aOneArgBlock
"opens a transaction and evaluates a block within the transaction; the
argument to the block is a view from derived from something
"
|text|
something notNil ifTrue:[
text := self transactionTextFor:something.
undoHistory transaction:aType text:text do:[
something isCollection ifTrue:[
something do:[:aView| aOneArgBlock value:aView ]
] ifFalse:[
aOneArgBlock value:something
]
]
]
!
transactionTextFor:anElementOrCollection
"returns text used by transaction or nil
"
|props size|
anElementOrCollection notNil ifTrue:[
anElementOrCollection isCollection ifTrue:[
size := anElementOrCollection size.
size == 0 ifTrue:[^ nil].
size ~~ 1 ifTrue:[^ size printString, ' elements'].
props := self propertyOfView:(anElementOrCollection at:1).
] ifFalse:[
props := self propertyOfView:anElementOrCollection
].
props notNil ifTrue:[ ^ props name ]
].
^ nil
! !
!UIPainterView methodsFor:'undo actions'!
undoCreate:aViewId
|view|
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
self removeObject:view
]
]
!
undoLayout:aViewId
"undo method layout
"
|view layout|
(view := self findViewWithId:aViewId) notNil ifTrue:[
layout := view geometryLayout copy.
view := nil.
layout notNil ifTrue:[
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
view geometryLayout:layout
]
]
] ifFalse:[
layout := view pixelOrigin.
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
view pixelOrigin:layout
]
]
]
]
!
undoLayoutView:aView
"undo method for changing layout on a view
"
|prop|
undoHistory isTransactionOpen ifTrue:[
prop := self propertyOfView:aView.
prop notNil ifTrue:[
self undoLayout:(prop identifier)
]
]
!
undoRemove:aViewId
"prepare undo method
"
|view prop spec parentId|
(view := self findViewWithId:aViewId) notNil ifTrue:[
spec := (self generateSpecFor:view) first.
view := view superView.
(self supportsSubComponents:view) ifTrue:[
prop := self propertyOfView:view.
prop notNil ifTrue:[
parentId := prop identifier
]
].
view := nil.
prop := nil.
undoHistory addUndoBlock:[
|builder|
builder := UIBuilder new.
view := self findViewWithId:parentId.
view isNil ifTrue:[
view := self
].
builder componentCreationHook:[:aView :aSpec :aBuilder |
self createdComponent:aView forSpec:aSpec builder:aBuilder.
].
builder applicationClass:(Smalltalk classNamed:className).
(spec buildViewWithLayoutFor:builder in:view) realize.
inputView raise.
].
]
!
undoSpecModify:aViewId
"undo for updateFromSpec
"
|builder view spec|
(view := self findViewWithId:aViewId) notNil ifTrue:[
spec := (self generateSpecFor:view) first.
view := nil.
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
builder := UIBuilder new.
spec setAttributesIn:view with:builder.
view superView sizeChanged:nil
]
]
].
! !
!UIPainterView methodsFor:'update from Specification'!
updateFromSpec:aSpec
"update current selected view from specification
"
|props name builder|
self singleSelection notNil ifTrue:[
self selectionHiddenDo:[
self transaction:#specification selectionDo:[:aView|
builder := UIBuilder new.
props := self propertyOfView:aView.
name := aSpec name.
self undoSpecModify:(props identifier).
name = (aView name) ifFalse:[
name notNil ifTrue:[
name := name withoutSeparators.
(name isEmpty or:[(self propertyOfName:name) notNil]) ifTrue:[
name := nil
]
].
name isNil ifTrue:[
aSpec name:(aView name).
]
].
aSpec setAttributesIn:aView with:builder.
aView superView sizeChanged:nil.
props tabable:aSpec tabable.
props defaultable:aSpec defaultable.
props initiallyInvisible:aSpec initiallyInvisible.
props aspectSelector:aSpec modelSelector.
props changeSelector:aSpec changeSelector.
props labelSelector:aSpec labelSelector.
props menuSelector:aSpec menuSelector.
].
self changed:#tree
]
].
! !
!UIPainterView::ViewProperty class methodsFor:'documentation'!
version
^ '$Header$'
! !
!UIPainterView::ViewProperty class methodsFor:'instance creation'!
new
Identifier notNil ifTrue:[Identifier := Identifier + 1]
ifFalse:[Identifier := 1].
^ self basicNew initialize
! !
!UIPainterView::ViewProperty methodsFor:'accessing'!
aspectSelector
"return the value of the instance variable 'aspectSelector' (automatically generated)"
^ aspectSelector
!
aspectSelector:something
"set the value of the instance variable 'aspectSelector' (automatically generated)"
aspectSelector := something.
!
changeSelector
"return the value of the instance variable 'changeSelector' (automatically generated)"
^ changeSelector!
changeSelector:something
"set the value of the instance variable 'changeSelector' (automatically generated)"
changeSelector := something.!
defaultable
"return the value of the instance variable 'defaultable' (automatically generated)"
^ defaultable!
defaultable:something
"set the value of the instance variable 'defaultable' (automatically generated)"
defaultable := something.!
elementClass
"return the value of the instance variable 'elementClass' (automatically generated)"
^ elementClass!
elementClass:something
"set the value of the instance variable 'elementClass' (automatically generated)"
elementClass := something.!
group
^ nil
!
identifier
"return the unique identifier assigned to property
"
^ identifier
!
initiallyInvisible
"return the value of the instance variable 'initiallyInvisible' (automatically generated)"
^ initiallyInvisible!
initiallyInvisible:something
"set the value of the instance variable 'initiallyInvisible' (automatically generated)"
initiallyInvisible := something.!
labelSelector
"return the value of the instance variable 'labelSelector' (automatically generated)"
^ labelSelector!
labelSelector:something
"set the value of the instance variable 'labelSelector' (automatically generated)"
labelSelector := something.!
menuSelector
"return the value of the instance variable 'menuSelector' (automatically generated)"
^ menuSelector!
menuSelector:something
"set the value of the instance variable 'menuSelector' (automatically generated)"
menuSelector := something.!
name
"return the value of the instance variable 'name' (automatically generated)"
^ view name
!
name:something
"set the value of the instance variable 'name' (automatically generated)"
view name:something
!
nameIndex
"return the value of the instance variable 'nameIndex' (automatically generated)"
^ nameIndex!
nameIndex:something
"set the value of the instance variable 'nameIndex' (automatically generated)"
nameIndex := something.!
tabable
"return the value of the instance variable 'tabable' (automatically generated)"
^ tabable!
tabable:something
"set the value of the instance variable 'tabable' (automatically generated)"
tabable := something.!
view
"return the value of the instance variable 'view' (automatically generated)"
^ view!
view:something
"set the value of the instance variable 'view' (automatically generated)"
view := something.! !
!UIPainterView::ViewProperty methodsFor:'initialization'!
initialize
super initialize.
identifier := Identifier
! !
!UIPainterView::GroupProperties methodsFor:'accessing'!
controlledObjects
"return the value of the instance variable 'controlledObjects' (automatically generated)"
^ controlledObjects!
controlledObjects:something
"set the value of the instance variable 'controlledObjects' (automatically generated)"
controlledObjects := something.!
group
"return the value of the instance variable 'group' (automatically generated)"
^ group!
group:something
"set the value of the instance variable 'group' (automatically generated)"
group := something.! !
!UIPainterView class methodsFor:'documentation'!
version
^ '$Header$'
! !