"
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.
"
UIObjectView subclass:#UIPainterView
instanceVariableNames:'fontPanel viewProperties superclassName className methodName
categoryName'
classVariableNames:'HandCursor'
poolDictionaries:''
category:'Interface-UIPainter'
!
Object subclass:#ViewProperty
instanceVariableNames:'view spec identifier'
classVariableNames:'Identifier'
poolDictionaries:''
privateIn:UIPainterView
!
UIPainterView::ViewProperty subclass:#GroupProperties
instanceVariableNames:'controlledObjects group name'
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"
!
applicationName
^ self className
!
applicationName:aName
self className:aName
!
className
^ className
!
className:aName
className := aName
!
className:aClassName superclassName:aSuperclassName selector:aSelector
className := aClassName.
superclassName := aSuperclassName.
methodName := aSelector.
!
methodName
^ methodName
!
methodName:aName
methodName := aName
!
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 methodsFor:'copy & cut & paste'!
copySelection
"copy the selection into the cut&paste-buffer
"
|specs coll|
coll := self minSetOfSuperViews:selection.
coll notNil ifTrue:[
self unselect.
specs := coll collect:[:aView| self fullSpecFor:aView ].
self setSelection:specs
].
!
deleteSelection
"delete the selection; copy the selection into the cut&paste-buffer
and open a transaction
"
|text specs coll|
coll := self minSetOfSuperViews:selection.
coll notNil ifTrue:[
self unselect.
specs := coll collect:[:aView| self fullSpecFor:aView ].
text := self transactionTextFor:coll.
undoHistory transaction:#cut text:text do:[
coll reverseDo:[:o||p|
(p := self propertyOfView:o) notNil ifTrue:[
self undoRemove:(p identifier)
].
self remove:o
]
].
self setSelection:specs.
self changed:#tree.
]
!
pasteBuffer
"add the objects in the paste-buffer to the object view
"
|paste frame pasteOrigin pasteOffset builder|
paste := self getSelection.
(self canPaste:paste) ifFalse:[ ^ self].
(paste isCollection) ifFalse:[ paste := Array with:paste].
frame := self singleSelection.
(self canPasteInto:frame) ifFalse:[
frame := self
].
self unselect.
selection := OrderedCollection new.
pasteOffset := 0@0.
pasteOrigin := self sensor mousePoint.
pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id.
builder := UIBuilder new.
paste do:[:aSpec|
|view|
view := self addSpec:aSpec builder: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 elementChangedSize:frame.
self changed:#tree
! !
!UIPainterView methodsFor:'drag & drop'!
canDrop:anObjectOrCollection
Transcript showCR:'canDrop'.
^ true
!
drop:anObjectOrCollection at:aPoint
Transcript showCR:'drop:anObjectOrCollection at:aPoint'.
! !
!UIPainterView methodsFor:'generating output'!
XXgenerateWindowSpecMethodSource
|spec specArray str code|
subViews remove:inputView.
[
spec := FullSpec fromView:self
] 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"
!
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|
code := ''.
className isNil ifTrue:[
self warn:'set the class first'.
^ code
].
viewProperties do:[:aProp |
|modelSelector menuSelector protoSpec thisCode|
(modelSelector := aProp model) 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
].
].
(menuSelector := aProp menu) notNil ifTrue:[
(cls implements:menuSelector asSymbol) ifFalse:[
protoSpec := aProp view specClass basicNew.
"/ kludge ..
thisCode := (self generateAspectMethodFor:menuSelector 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 uniqueNameOf: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 uniqueNameOf:(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'!
generateWindowSpecMethodSource
|t s spec specArray str code|
specArray := OrderedCollection new.
self subViews do:[:aView|
aView ~~ inputView ifTrue:[
specArray add:(self fullSpecFor:aView)
]
].
spec := FullSpec new.
spec fromBuilder:self components:(SpecCollection new collection:specArray).
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]
!
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 group objects|
selection isNil ifTrue:[^ self].
self selectionDo:[:aView |
(aView isKindOf:EditField) ifFalse:[
self warn:'select EditFields only !!'.
^ self
]
].
self withSelectionHiddenDo:[
group := EnterFieldGroup new.
props := GroupProperties new.
name := self uniqueNameFor:EnterFieldGroup.
props group:group.
props name:name.
group groupID:name asSymbol.
objects := OrderedCollection new.
props controlledObjects:objects.
viewProperties add:props.
self selectionDo:[:aView |
objects add:aView.
group add:aView
].
]
!
groupRadioButtons
|props name group objects|
selection isNil ifTrue:[^ self].
self selectionDo:[:aView |
(aView isKindOf:RadioButton) ifFalse:[
self warn:'select RadioButtons only !!'.
^ self
]
].
self withSelectionHiddenDo:[
group := RadioButtonGroup new.
props := GroupProperties new.
name := self uniqueNameFor:RadioButtonGroup.
props group:group.
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
"setup attributes
"
super initialize.
superclassName := 'ApplicationModel'.
className := 'NewApplication'.
methodName := 'windowSpec'.
categoryName := 'Applications'.
viewProperties := OrderedCollection new.
HandCursor := Cursor leftHand.
"Modified: 5.9.1995 / 19:58:06 / claus"
!
initializeCreatedObject:anObject
"set default properties for a created object
"
|props spec cls|
cls := anObject class.
spec := anObject specClass fromView:anObject.
props := ViewProperty new.
props view:anObject.
props spec:spec.
props name:(self uniqueNameFor:cls).
viewProperties add:props.
((anObject respondsTo:#label:) and:[(spec respondsTo:#label:)]) ifTrue:[
anObject label:(props name).
spec label:(props name)
].
undoHistory transaction:#create text:(props name) do:[
self undoCreate:(props identifier).
].
!
setupFromSpec:specOrSpecArray
|spec builder|
self removeAll.
spec := UISpecification from:specOrSpecArray.
builder := UIBuilder new.
spec window setupView:self topView for:builder.
self addSpec:(spec component) builder:builder in:self.
self realizeAllSubViews.
inputView raise.
self changed:#tree.
! !
!UIPainterView methodsFor:'menus'!
menu
"returns middle-button menu dependent on the selection
"
|menu canPaste undoIdx undoText|
testMode ifTrue:[^ nil ].
canPaste := self canPaste:(self getSelection).
undoText := undoHistory lastTypeAsString.
selection isNil ifTrue:[
undoIdx := 2.
menu := PopUpMenu labels:( resources array:#('paste' 'undo') )
selectors:#( #pasteBuffer #undoLast )
accelerators:#( #Paste nil )
receiver:self.
canPaste ifFalse:[menu disable:#pasteBuffer].
] ifFalse:[
undoIdx := 4.
menu := PopUpMenu labels:( resources array:#(
'copy'
'cut'
'paste'
'undo'
'-'
'arrange'
'dimension'
'align'
)
)
selectors:#( #copySelection
#deleteSelection
#pasteBuffer
#undoLast
nil
#arrange
#dimension
#align
)
accelerators:#(#Copy
#Cut
#Paste
nil
nil
nil
nil
nil
)
receiver:self.
(canPaste and:[self canPasteInto:selection]) ifFalse:[
menu disable:#pasteBuffer
].
menu subMenuAt:#arrange put:(self subMenuArrange).
menu subMenuAt:#dimension put:(self subMenuDimension).
menu subMenuAt:#align put:(self subMenuAlign).
].
undoText notNil ifTrue:[
menu labelAt:undoIdx put:((menu labels at:undoIdx), ': ', undoText)
] ifFalse:[
menu disable:#undoLast
].
^ menu
!
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
]
!
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
nil
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 withSelectionHiddenDo:[
self selectionDo:[:aView |
aView font:f.
self elementChangedSize:aView.
]
].
self changed:#any.
]
"Modified: 5.9.1995 / 12:13:27 / claus"
! !
!UIPainterView methodsFor:'removing components'!
remove:anObject
"remove anObject from the contents do redraw
"
|props|
anObject notNil ifTrue:[
(anObject subViews notNil) ifTrue:[
anObject subViews copy do:[:sub |
self remove:sub
]
].
(props := self propertyOfView:anObject) notNil ifTrue:[
viewProperties remove:props ifAbsent:nil
].
anObject destroy
]
!
removeAll
"remove all objects and properties
"
self unselect.
viewProperties := OrderedCollection new.
subViews notNil ifTrue:[
subViews copy do:[:sub |
sub ~~ inputView ifTrue:[
self remove:sub
]
]
].
undoHistory reinitialize.
self changed:#tree
! !
!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 identifier and returns the view or nil
"
|prop|
prop := self propertyOfIdentifier:aViewId.
prop notNil ifTrue:[^ prop view]
ifFalse:[^ nil]
!
propertyOfGroup:aGroup
"returns property assigned to group
"
^ viewProperties detect:[:p| p group == aGroup] ifNone:nil
!
propertyOfIdentifier:anId
"returns property assigned to unique identifier
"
anId notNil ifTrue:[
^ viewProperties detect:[:p| p identifier == anId] ifNone:nil.
].
^ nil
!
propertyOfName:aString
"returns property assigned to name
"
aString = 'self' ifFalse:[
^ viewProperties detect:[:p| p name = aString] ifNone:nil
].
^ nil
!
propertyOfView:aView
"returns property assigned to view
"
(aView isNil or:[aView == self]) ifFalse:[
^ viewProperties detect:[:p| p view == aView] ifNone:nil
].
^ nil
!
uniqueNameFor:aClass
"generate and return an unique name for a class
"
|next name size|
next := 0.
name := aClass name asString copy.
size := name size + 1.
name at:1 put:(name at:1) asLowercase.
viewProperties do:[:p||n|
n := p name.
(n size >= size and:[n startsWith:name]) ifTrue:[
next := next max:(p extractNumberStartingAt:size)
]
].
next := next + 1.
name := name, next printString.
^ name
!
uniqueNameOf:aView
|prop|
aView notNil ifTrue:[
prop := self propertyOfView:aView
].
prop notNil ifTrue:[^ prop name]
ifFalse:[^ 'self']
! !
!UIPainterView methodsFor:'selection'!
addTreeFrom:aView to:aCollection
"add aView and contained subcomponents to collection
"
(self propertyOfView:aView) notNil ifTrue:[
aCollection add:aView.
(aView subViews notNil) ifTrue:[
aView subViews do:[:subView|
self addTreeFrom:subView to:aCollection
]
].
]
!
selectSubComponents
"select all subcomponents for current selection
"
|startAtView aCollection|
aCollection := OrderedCollection new.
startAtView := self singleSelection.
startAtView isNil ifTrue:[
self subViews notNil ifTrue:[
self subViews do:[:subView|
subView ~~ inputView ifTrue:[
self addTreeFrom:subView to:aCollection
]
]
]
] ifFalse:[
self addTreeFrom:startAtView to:aCollection
].
aCollection size > 1 ifTrue:[
self withSelectionHiddenDo:[
selection := aCollection
].
self changed:#selection
]
! !
!UIPainterView methodsFor:'specification'!
addSpec:aSpecification builder:aBuilder in:aFrame
"build view and subviews from aSpecification into a frame. The top view
is returned. The contained components of a spec are set to nil
"
aBuilder applicationClass:(Smalltalk classNamed:className).
aBuilder componentCreationHook:[:aView :aSpec :aBdr||sv p s|
p := ViewProperty new.
s := aSpec copy.
p spec:s.
p view:aView.
s class supportsSubComponents ifTrue:[
s component:nil
].
(self propertyOfName:(s name)) notNil ifTrue:[
s name:(self uniqueNameFor:(aView class))
].
viewProperties add:p
].
^ aSpecification buildViewWithLayoutFor:aBuilder in:aFrame.
!
fullSpecFor:anObject
"generate a full spec for an object
"
|mySpec subSpecs|
mySpec := self specFor:anObject.
(mySpec notNil and:[mySpec class supportsSubComponents]) ifTrue:[
(anObject subViews notNil) ifTrue:[
anObject subViews do:[:aSubView||spec|
spec := self fullSpecFor:aSubView.
spec notNil ifTrue:[
subSpecs isNil ifTrue:[
subSpecs := OrderedCollection new
].
subSpecs add:spec.
].
].
subSpecs notNil ifTrue:[
mySpec component:(SpecCollection new collection:subSpecs)
]
]
].
^ mySpec
!
specFor:anObject
"returns spec assigned to an object
"
|prop spec|
(prop := self propertyOfView:anObject) notNil ifTrue:[
spec := prop spec copy.
spec layoutFromView:anObject
].
^ spec
!
updateFromSpec:aSpec
"update current selected view from specification
"
|props name builder v|
self singleSelection notNil ifTrue:[
self withSelectionHiddenDo:[
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 needsRebuildForAttributes ifTrue:[
v := aSpec buildViewWithLayoutFor:builder in:aView superView.
v realize.
aView destroy.
device sync. device flush.
aView becomeSameAs:v.
inputView raise.
] ifFalse:[
aSpec setAttributesIn:aView with:builder.
self elementChangedSize:aView.
].
props spec:(aSpec copy).
]
].
self changed:#tree
].
"Modified: 1.3.1997 / 01:39:53 / cg"
! !
!UIPainterView methodsFor:'testing'!
isHorizontalResizable:aComponent
"returns true if instance is horizontal resizeable
"
(aComponent isKindOf:ScrollBar) ifTrue:[
^ aComponent orientation == #horizontal
].
(aComponent isKindOf:Scroller) ifTrue:[
^ aComponent orientation == #horizontal
].
(aComponent isKindOf:Slider) ifTrue:[
^ aComponent orientation == #horizontal
].
^ true
!
isVerticalResizable:aComponent
"returns true if instance is vertical resizeable
"
(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
"undo method when creating or pasting an object
"
undoHistory addUndoBlock:[
self remove:(self findViewWithId:aViewId)
]
!
undoLayout:aViewId
"undo method when changing the layout (position or dimension)
"
|view layout extent|
(view := self findViewWithId:aViewId) notNil ifTrue:[
(layout := view geometryLayout copy) isNil ifTrue:[
extent := view extent copy
].
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
layout notNil ifTrue:[view geometryLayout:layout]
ifFalse:[view extent:extent]
]
]
].
view := nil
!
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
"undo method when removing an object
"
|frame prop spec parentId|
frame := self findViewWithId:aViewId.
spec := self fullSpecFor:frame.
frame := frame superView.
(self canPasteInto:frame) ifTrue:[
(prop := self propertyOfView:frame) notNil ifTrue:[
parentId := prop identifier
]
].
frame := nil.
prop := nil.
undoHistory addUndoBlock:[
|view|
frame := self findViewWithId:parentId.
frame isNil ifTrue:[
frame := self
].
view := self addSpec:spec builder:(UIBuilder new) in:frame.
view realize.
inputView raise.
]
!
undoSpecModify:aViewId
"undo method when changing the specification for an object
"
|builder view spec v|
(view := self findViewWithId:aViewId) notNil ifTrue:[
spec := self specFor:view.
view := nil.
undoHistory addUndoBlock:[
(view := self findViewWithId:aViewId) notNil ifTrue:[
builder := UIBuilder new.
spec needsRebuildForAttributes ifTrue:[
v := spec buildViewWithLayoutFor:builder in:view superView.
v realize.
view destroy.
view become:v.
] ifFalse:[
spec setAttributesIn:view with:builder.
self elementChangedSize:view.
].
]
]
].
! !
!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'!
group
^ nil
!
identifier
"return the unique identifier assigned to property
"
^ identifier
!
spec
"return the value of the instance variable 'spec' (automatically generated)"
^ spec!
spec:something
"set the value of the instance variable 'spec' (automatically generated)"
spec := 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::ViewProperty methodsFor:'misc'!
extractNumberStartingAt:anIndex
"return the number from the name starting at anIndex or 0.
"
|val|
val := 0.
self name from:anIndex do:[:c|
c isDigit ifTrue:[val := val * 10 + c digitValue]
ifFalse:[^ 0]
].
^ val
! !
!UIPainterView::ViewProperty methodsFor:'spec messages'!
doesNotUnderstand:aMessage
spec notNil ifTrue:[
(spec respondsTo:(aMessage selector)) ifTrue:[^ aMessage sendTo:spec]
].
^ nil
!
layout
spec layout
!
layout:aLayout
spec layout:aLayout
!
name
^ spec name
!
name:aName
spec name:aName
! !
!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'
"
^ group
!
group:something
"set the value of the instance variable 'group'
"
group := something.
!
name
"return the value of the group name
"
^ name
!
name:aName
"set the value of the group name
"
name := aName
! !
!UIPainterView class methodsFor:'documentation'!
version
^ '$Header$'
! !