help ...
"
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:'listHolder superclassName className methodName categoryName'
classVariableNames:'HandCursor'
poolDictionaries:''
category:'Interface-UIPainter'
!
Object subclass:#ViewProperty
instanceVariableNames:'view spec identifier'
classVariableNames:'Identifier'
poolDictionaries:''
privateIn:UIPainterView
!
MultiSelectionInList subclass:#ListHolder
instanceVariableNames:'painter propertyList masterElement disabledChanged'
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
"
buildIn view used by the UIPainter; from this view, the layout of the
new application derives from.
[see also:]
UIBuilder
UIObjectView
"
! !
!UIPainterView class methodsFor:'defaults'!
defaultMenuMessage
"This message is the default yo be sent to the menuHolder to get a menu
"
^ #showMiddleButtonMenu
! !
!UIPainterView class methodsFor:'menu specs'!
menu
^ #(#Menu #(
#(#MenuItem
#'label:' 'copy'
#'value:' #copySelection
#'shortcutKeyCharacter:' #Copy
)
#(#MenuItem
#'label:' 'cut'
#'value:' #deleteSelection
#'shortcutKeyCharacter:' #Cut
)
#(#MenuItem
#'label:' 'paste'
#'nameKey:' #paste
#'value:' #paste
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'paste'
#'value:' #pasteBuffer
#'shortcutKeyCharacter:' #Paste
)
#(#MenuItem
#'label:' 'keep layout'
#'value:' #pasteWithLayout
)
)
nil
nil
)
)
#(#MenuItem
#'label:' 'undo'
#'nameKey:' #undo
#'value:' #undoLast)
#(#MenuItem
#'label:' 'arrange'
#'value:' #arrange
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'to front'
#'value:' #raiseSelection
)
#(#MenuItem
#'label:' 'to back'
#'value:' #lowerSelection
)
)
nil
nil
)
)
#(#MenuItem
#'label:' 'dimension'
#'value:' #dimension
#'submenu:'
#(#Menu #(
#(#MenuItem
#'label:' 'default extent'
#'value:' #setToDefaultExtent
)
#(#MenuItem
#'label:' 'default width'
#'value:' #setToDefaultWidth
)
#(#MenuItem
#'label:' 'default height'
#'value:' #setToDefaultHeight
)
#(#MenuItem
#'label:' 'copy extent'
#'value:' #copyExtent
)
#(#MenuItem
#'label:' 'paste extent'
#'value:' #pasteExtent
)
#(#MenuItem
#'label:' 'paste width'
#'value:' #pasteWidth
)
#(#MenuItem
#'label:' 'paste height'
#'value:' #pasteHeight
)
#(#MenuItem
#'label:' 'copy layout'
#'value:' #copyLayout
)
#(#MenuItem
#'label:' 'paste layout'
#'value:' #pasteLayout
)
)
#(3 1 3)
nil
)
)
#(#MenuItem
#'label:' 'align'
#'value:' #align
#'submenu:'
#(#Menu #(
#(#MenuItem
#'value:' #alignSelectionLeft
#'labelImage:' #( ResourceRetriever UIPainter iconAlignL 'align left' )
)
#(#MenuItem
#'value:' #alignSelectionRight
#'labelImage:' #( ResourceRetriever UIPainter iconAlignR 'align right' )
)
#(#MenuItem
#'value:' #alignSelectionLeftAndRight
#'labelImage:' #( ResourceRetriever UIPainter iconAlignLR 'align left & right' )
)
#(#MenuItem
#'value:' #alignSelectionTop
#'labelImage:' #( ResourceRetriever UIPainter iconAlignT 'align top' )
)
#(#MenuItem
#'value:' #alignSelectionBottom
#'labelImage:' #( ResourceRetriever UIPainter iconAlignB 'align bottom' )
)
#(#MenuItem
#'value:' #alignSelectionTopAndBottom
#'labelImage:' #( ResourceRetriever UIPainter iconAlignTB 'align top & bottom' )
)
#(#MenuItem
#'value:' #alignSelectionCenterHor
#'labelImage:' #( ResourceRetriever UIPainter iconAlignCenterH 'align centered horizontal' )
)
#(#MenuItem
#'value:' #alignSelectionCenterVer
#'labelImage:' #( ResourceRetriever UIPainter iconAlignCenterV 'align centered vertical' )
)
#(#MenuItem
#'label:' 'spread horizontal'
#'value:' #spreadSelectionHor
)
#(#MenuItem
#'label:' 'spread vertical'
#'value:' #spreadSelectionVer
)
#(#MenuItem
#'label:' 'center horizontal in frame'
#'value:' #centerSelectionHor
)
#(#MenuItem
#'label:' 'center vertical in frame'
#'value:' #centerSelectionVer
)
)
#(8 2)
nil
)
)
)
#(4)
nil
)
! !
!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.
!
listHolder
^ listHolder
!
methodName
^ methodName
!
methodName:aName
methodName := aName
!
selectNames:aStringOrCollection
|prop coll s|
(aStringOrCollection isNil or:[aStringOrCollection isEmpty]) ifTrue:[
^ self select:nil
].
(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 select:nil ].
^ self select:coll.
]
].
prop := self propertyOfName:s.
prop isNil ifTrue:[^ self select:nil]
ifFalse:[^ self select:(prop view)]
! !
!UIPainterView methodsFor:'change & update'!
changed:aParameter
aParameter == #layout ifTrue:[
listHolder removeDependent:self.
listHolder changed:aParameter.
listHolder addDependent:self.
] ifFalse:[
super changed:aParameter
]
!
selectionChanged
"selection has changed
"
|newSel|
self selectionDo:[:aView||p|
(p := self propertyOfView:aView) notNil ifTrue:[
newSel isNil ifTrue:[
newSel := OrderedCollection new
].
newSel add:(listHolder indexOfName:(p name))
]
].
listHolder removeDependent:self.
listHolder selectionIndex:newSel.
listHolder addDependent:self.
!
update:what with:aParm from:aSender
|loIdx newSel|
(what == #selectionIndex and:[aSender == listHolder]) ifFalse:[
^ self
].
loIdx := listHolder selectionIndex.
loIdx size ~~ 0 ifTrue:[
newSel := loIdx collect:[:i|(listHolder propertyAt:i) view]
].
self updateSelectionFrom:newSel.
!
updateSelectionFrom:aSel
"update selection from a new selection
"
|csel|
selectionHiddenLevel == 0 ifTrue:[
aSel isCollection ifTrue:[
self selectionDo:[:el|
(aSel includes:el) ifFalse:[self showUnselected:el]
]
] ifFalse:[
self selectionDo:[:el|
aSel == el ifFalse:[self showUnselected:el]
]
]
].
self setSelection:aSel withRedraw:false.
self showSelection
! !
!UIPainterView methodsFor:'copy & cut & paste'!
copySelection
"copy the selection into the cut&paste-buffer
"
|specs coll|
coll := self minSetOfSuperViews:(self selection).
coll notNil ifTrue:[
self select:nil.
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
"
|specs coll|
coll := self minSetOfSuperViews:(self selection).
coll notNil ifTrue:[
listHolder disableNotificationsWhileEvaluating:[
self select:nil.
specs := coll collect:[:aView| self fullSpecFor:aView ].
self withinTransaction:#cut objects:coll do:[
coll reverseDo:[:aView|
self createUndoRemove:aView.
self remove:aView
]
].
self setSelection:specs.
]
]
!
pasteBuffer
"add the objects in the paste-buffer to the object view
"
self pasteSpecifications:(self getSelection) keepLayout:false
!
pasteSpecifications:aSpecificationOrList keepLayout:keepLayout
"add the specs to the object view
"
|paste frame pasteOrigin pasteOffset builder newSel|
(self canPaste:aSpecificationOrList) ifFalse:[
^ self
].
aSpecificationOrList isCollection ifTrue:[
paste := aSpecificationOrList
] ifFalse:[
paste := Array with:aSpecificationOrList
].
frame := self singleSelection.
(self canPasteInto:frame) ifFalse:[
frame := self
].
self select:nil.
newSel := OrderedCollection new.
builder := UIBuilder new.
keepLayout ifFalse:[
pasteOffset := 0@0.
pasteOrigin := self sensor mousePoint.
pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id.
].
listHolder disableNotificationsWhileEvaluating:[
paste do:[:aSpec|
|view|
view := self addSpec:aSpec builder:builder in:frame.
keepLayout ifFalse:[
(frame bounds containsPoint:pasteOrigin) ifFalse:[
self moveObject:view to:pasteOffset.
] ifTrue:[
self moveObject:view to:pasteOrigin + pasteOffset.
].
pasteOffset := pasteOffset + 4
].
view realize.
newSel add:view.
].
].
self withinTransaction:#paste objects:newSel do:[
undoHistory addUndoSelector:#undoCreate:
withArgs:(newSel collect:[:v|(self propertyOfView:v) identifier])
].
newSel size == 1 ifTrue:[
newSel := newSel at:1
].
self realizeAllSubViews.
inputView raise.
self select:newSel.
self elementChangedSize:frame.
!
pasteWithLayout
"add the objects in the paste-buffer to the object view; don't change the
layout
"
self pasteSpecifications:(self getSelection) keepLayout:true
! !
!UIPainterView methodsFor:'drag & drop'!
canDrop:anObjectOrCollection
|spec|
self enabled ifTrue:[
anObjectOrCollection size == 1 ifTrue:[
spec := (anObjectOrCollection at:1) theObject.
^ (spec isKindOf:UISpecification)
]
].
^ false
"Modified: 8.4.1997 / 01:01:50 / cg"
!
drop:anObjectOrCollection at:aPoint
|spec|
spec := (anObjectOrCollection at:1) theObject.
self pasteSpecifications:spec keepLayout:false.
! !
!UIPainterView methodsFor:'generating output'!
generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
|args showIt|
(aspect asSymbol numArgs) == 1 ifFalse:[
args := '\'.
showIt := ' ...''.\'.
] ifTrue:[
args := 'anArgument\'.
showIt := ''' , anArgument printString , '' ...''.\'.
].
^ ('!!' , targetClass name , ' methodsFor:''actions''!!\\' ,
aspect , args ,
' "automatically generated by UIPainter ..."\' ,
'\' ,
' "action to be added ..."\' ,
' Transcript showCR:self class name , '': action for ' , aspect , showIt ,
'!! !!\\') withCRs
!
generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
|modelClass|
modelClass := protoSpec defaultModelClassFor:aspect.
^ ('!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,
aspect , '\' ,
' "automatically generated by UIPainter ..."\' ,
'\' ,
' |holder|\' ,
'\' ,
' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
' builder aspectAt:#' , aspect , ' put:(holder := ' , ' ' , modelClass name , ' new' , ').\' ,
' ].\' ,
' ^ holder\' ,
'!! !!\\') withCRs
!
generateAspectMethods
|cls code|
code := ''.
className isNil ifTrue:[
self warn:'set the class first'.
^ code
].
cls := Smalltalk classNamed:className.
listHolder propertiesDo:[:aProp |
|modelSelector menuSelector protoSpec thisCode|
protoSpec := aProp spec.
protoSpec isNil ifTrue:[
self halt.
protoSpec := aProp view specClass basicNew.
].
(modelSelector := aProp model) notNil ifTrue:[
(cls implements:modelSelector asSymbol) ifFalse:[
"/ 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:[
"/ kludge ..
thisCode := (self generateAspectMethodFor:menuSelector spec:protoSpec inClass:cls).
code := code , thisCode
]
].
aProp spec aspectSelectors do:[:aSel|
(cls implements:aSel asSymbol) ifFalse:[
"/ kludge ..
thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
code := code , thisCode
]
].
aProp spec actionSelectors do:[:aSel|
(cls implements:aSel asSymbol) ifFalse:[
"/ kludge ..
thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
code := code , thisCode
]
].
].
^ code
!
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
!
generateCode
"generate code for the windowSpec method"
|code|
self resetModification.
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"
!
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\' withCRs.
defCode := Character excla asString , '\\'.
defCode := defCode , 'setupLocalStuff\'.
defCode := defCode , ' ^ self\'.
defCode := defCode , Character excla asString , ' ' ,
Character excla asString , '\\'.
code := code , defCode withCRs.
^ code.
!
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.
UISpecification 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"
!
storeContentsOn:aStream
listHolder propertiesDo:[:p| p storeOn:aStream]
!
subviewsOf:aView do:aBlock
|subs v|
(subs := aView subViews) notNil ifTrue:[
subs do:[:v|
(v ~~ inputView and:[v notNil]) ifTrue:[
(listHolder detectProperty:[:p|p view == v]) notNil ifTrue:[
(v superView == aView) ifTrue:[
aBlock value:v
]
]
]
]
]
! !
!UIPainterView methodsFor:'initialization'!
destroy
"remove dependencies
"
listHolder notNil ifTrue:[
listHolder removeDependent:self.
].
super destroy.
!
initialize
"setup attributes
"
super initialize.
superclassName := 'ApplicationModel'.
className := 'NewApplication'.
methodName := 'windowSpec'.
categoryName := 'Applications'.
listHolder := ListHolder for:self.
HandCursor := Cursor leftHand.
!
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:spec).
listHolder add:props.
((spec respondsTo:#label:) and:[self supportsLabel:anObject]) ifTrue:[
anObject label:(props name).
spec label:(props name)
].
undoHistory withinTransaction:#create text:(props name) do:[
undoHistory addUndoSelector:#undoCreate: withArgs:(props identifier)
].
!
setupFromSpec:specOrSpecArray
|spec builder|
listHolder disableNotificationsWhileEvaluating:[
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.
]
! !
!UIPainterView methodsFor:'menus'!
showMiddleButtonMenu
"show the middle button menu; this returns nil
"
|menu canPaste|
self enabled ifFalse:[
^ nil
].
menu := MenuPanel fromSpec:(self class menu) receiver:self.
canPaste := self canPaste:(self getSelection).
self hasSelection ifTrue:[
canPaste := (canPaste and:[self canPasteInto:(self selection)])
] ifFalse:[
menu disableAll
].
menu enabledAt:#paste put:canPaste.
menu enabledAt:#undo put:(undoHistory isEmpty not).
menu startUp.
^ nil
! !
!UIPainterView methodsFor:'removing components'!
remove:anObject
"remove anObject from the contents do redraw
"
anObject notNil ifTrue:[
listHolder remove:anObject
]
!
removeAll
"remove all objects and properties
"
listHolder disableNotificationsWhileEvaluating:[
self select:nil.
listHolder removeAll.
self removeUndoHistory.
]
! !
!UIPainterView methodsFor:'searching'!
findContainerViewAt:aPoint
"find container view responds to aPoint.
"
|view|
(view := self findObjectAt:aPoint) isNil ifTrue:[
^ self
].
[(view specClass supportsSubComponents or:[(view := view superView) == self])
] whileFalse:[
[(self propertyOfView:view) isNil] whileTrue:[
(view := view superView) == self ifTrue:[^ self]
].
].
^ view
!
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]
!
propertyOfIdentifier:anId
"returns property assigned to unique identifier
"
anId notNil ifTrue:[
^ listHolder detectProperty:[:p| p identifier == anId ]
].
^ nil
!
propertyOfName:aString
"returns property assigned to name
"
|name|
aString isNil ifFalse:[
name := aString string withoutSeparators.
name = 'self' ifFalse:[
^ listHolder detectProperty:[:p| p name = name ].
]
].
^ nil
!
propertyOfView:aView
"returns property assigned to view
"
(aView isNil or:[aView == self]) ifFalse:[
^ listHolder detectProperty:[:p| p view == aView ]
].
^ nil
!
uniqueNameFor:aSpecOrString
"generate and return an unique name for a class
"
|next name size|
aSpecOrString isString ifFalse:[name := aSpecOrString className asString]
ifTrue:[name := aSpecOrString].
(name endsWith:'Spec') ifTrue:[
name := name copyFrom:1 to:(name size - 4).
] ifFalse:[
name := name copy
].
name at:1 put:(name at:1) asLowercase.
size := name size + 1.
next := 0.
listHolder propertiesDo:[: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|
(prop := self propertyOfView:aView) notNil ifTrue:[
prop name isNil ifTrue:[
prop name:(self uniqueNameFor:(prop spec)).
].
^ prop name
].
^ '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 updateSelectionFrom:aCollection.
self selectionChanged
]
! !
!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 n|
p := ViewProperty new.
s := aSpec copy.
p spec:s.
p view:aView.
s class supportsSubComponents ifTrue:[
s component:nil
].
n := s name.
(n isNil or:[(self propertyOfName:n) notNil]) ifTrue:[
s name:(self uniqueNameFor:s)
].
listHolder 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
!
specForSelection
"returns spec assigned to current single selection or nil
"
^ self specFor:(self singleSelection)
!
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) withoutSeparators.
name = props name ifFalse:[
(self propertyOfName:name) notNil ifTrue:[
name := props name
]
].
aSpec name:name.
self createUndoSpecModify:props.
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).
listHolder propertyChanged:props.
]
]
]
! !
!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
!
supportsLabel:aComponent
"returns true if component supports label
"
(aComponent respondsTo:#label:) ifTrue:[
( (aComponent isKindOf:ArrowButton)
or:[aComponent isKindOf:CheckToggle]
) ifFalse:[
^ true
]
].
^ false
! !
!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
"
self withinTransaction:aType objects:something do:[
self forEach:something do:aOneArgBlock
]
!
withinTransaction:aType objects:objects do:aNoneArgBlock
"evaluate a block with no arguments within a transaction
"
|text size prop|
objects isNil ifTrue:[ ^ self ].
size := objects size.
objects isCollection ifTrue:[
size == 0 ifTrue:[ ^ self ].
size == 1 ifTrue:[ prop := self propertyOfView:(objects first) ]
] ifFalse:[
prop := self propertyOfView:objects
].
prop notNil ifTrue:[
text := prop name
] ifFalse:[
text := size printString, ' elements'
].
undoHistory withinTransaction:aType text:text do:[
aNoneArgBlock value
]
! !
!UIPainterView methodsFor:'undo actions'!
createUndoLayout:aView
"create undo action before changing a views layout
"
|lyt args prop|
undoHistory isTransactionOpen ifTrue:[
prop := self propertyOfView:aView.
prop notNil ifTrue:[
args := Array new:3.
args at:1 put:(prop identifier).
(lyt := aView geometryLayout) notNil ifTrue:[
args at:2 put:#geometryLayout:
] ifFalse:[
lyt := aView extent.
args at:2 put:#extent:
].
args at:3 put:(lyt copy).
undoHistory addUndoSelector:#undoLayout: withArgs:args.
]
]
!
createUndoRemove:aView
"create undo method before deleting views
"
|frame prop pId spec|
(prop := self propertyOfView:aView) notNil ifTrue:[
spec := self fullSpecFor:aView.
frame := aView superView.
(self canPasteInto:frame) ifTrue:[
(frame := self propertyOfView:frame) notNil ifTrue:[
pId := frame identifier
]
].
undoHistory addUndoSelector:#undoRemove:
withArgs:(Array with:spec with:(prop identifier) with:pId)
]
!
createUndoSpecModify:aProp
"undo method when changing the specification for an object
"
aProp notNil ifTrue:[
undoHistory addUndoSelector:#undoSpecModify:
withArgs:(Array with:(aProp spec) with:(aProp identifier))
]
!
undoCreate:something
"undo method for creating or pasting an object
"
self forEach:something do:[:anId|self remove:(self findViewWithId:anId)].
!
undoLayout:args
"undo method to set the old layout; see 'createUndoLayout:'
"
|view|
(view := self findViewWithId:(args at:1)) notNil ifTrue:[
view perform:(args at:2) with:(args at:3).
self changed:#layout.
]
!
undoRemove:args
"undo method when removing an object; see 'createUndoRemove:'
"
|frame prop view|
(args at:3) notNil ifTrue:[
frame := self findViewWithId:(args at:3).
].
frame isNil ifTrue:[
frame := self
].
view := self addSpec:(args at:1) builder:(UIBuilder new) in:frame.
view realize.
inputView raise.
prop := self propertyOfView:view.
prop identifier:(args at:2).
!
undoSpecModify:args
"undo method when changing a spec; see 'createUndoSpecModify:'
"
|builder view spec v props|
props := self propertyOfIdentifier:(args at:2).
props notNil ifTrue:[
view := props view.
spec := args at:1.
builder := UIBuilder new.
props spec:spec.
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.
].
listHolder propertyChanged:props.
]
! !
!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'!
identifier
"return the unique identifier assigned to property
"
^ identifier
!
identifier:anIdentifier
"set the unique identifier assigned to property; called after an restore of
a deleted instance
"
identifier := anIdentifier
!
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::ListHolder class methodsFor:'instance creation'!
for:aPainter
^ self new for:aPainter
! !
!UIPainterView::ListHolder methodsFor:'accessing'!
painter
"returns painter
"
^ painter
!
propertyAt:anIndex
"returns property at an index
"
^ propertyList at:anIndex
! !
!UIPainterView::ListHolder methodsFor:'adding & removing'!
add:aProperty
"add property and update list
"
|idx list name last|
list := self list.
idx := self findParentProperty:aProperty.
name := aProperty name.
idx == 0 ifTrue:[
last := list size
] ifFalse:[
last := self lastInGroupStartingAt:idx.
name := (String new:(4+((list at:idx) leftIndent))), name.
].
propertyList add:aProperty afterIndex:last.
list add:name afterIndex:last.
self changed:#size
!
remove:aView
"remove all view relevant resources
"
|start|
aView notNil ifTrue:[
start := self findProperty:[:p| p view == aView ].
start ~~ 0 ifTrue:[
self basicRemove:start.
self changed:#size.
]
]
!
removeAll
masterElement := nil.
self selection:#().
[propertyList notEmpty] whileTrue:[
self basicRemove:1
].
self changed:#size.
! !
!UIPainterView::ListHolder methodsFor:'change & update'!
changed:aParameter
"notify all dependents that the receiver has changed somehow.
Each dependent gets a '#update:'-message with aParameter
as argument. In case of disabled no notifications are raised
"
disabledChanged ifFalse:[
super changed:aParameter
]
!
disableNotificationsWhileEvaluating:aBlock
"perform block without notification; after evaluation of block,
a #size changed notification is raised
"
|oldState|
oldState := disabledChanged.
disabledChanged := true.
aBlock value.
disabledChanged := oldState.
self changed:#size.
!
propertyChanged:aProperty
"property list changed; update list names
"
|list idx oldName newName wspName view indent mid|
view := aProperty view.
idx := self findProperty:[:p| p view == view ].
idx == 0 ifTrue:[
^ self error
].
list := self list.
oldName := list at:idx.
wspName := oldName string withoutSeparators.
newName := aProperty name.
wspName = newName ifFalse:[
mid := self masterElement.
list at:idx put:((String new:(oldName leftIndent)), newName).
idx == mid ifTrue:[
masterElement := nil.
self masterElement:idx
].
].
self changed:#property
! !
!UIPainterView::ListHolder methodsFor:'enumerating'!
propertiesDo:aBlock
"evaluate a block for each property
"
propertyList do:aBlock
! !
!UIPainterView::ListHolder methodsFor:'initialization'!
for:aPainter
"initialize for a painter
"
painter := aPainter.
disabledChanged := false.
self list:(OrderedCollection new).
propertyList := OrderedCollection new.
self selection:#().
self addDependent:painter.
! !
!UIPainterView::ListHolder methodsFor:'private'!
basicRemove:start
"remove all resources assigned to a group starting at start;
no notifications are raised
"
|end view superView|
end := self lastInGroupStartingAt:start.
view := (propertyList at:start) view.
view notNil ifTrue:[
superView := view superView.
view destroy.
superView sizeChanged:nil.
].
propertyList removeFromIndex:start toIndex:end.
self list removeFromIndex:start toIndex:end.
!
masterElement
"returns index of master
"
^ self indexOfName:masterElement.
!
masterElement:newIndex
"change master of selection
"
|name list oldIdx|
(oldIdx := self masterElement) ~~ newIndex ifTrue:[
list := self list.
oldIdx ~~ 0 ifTrue:[
list at:oldIdx put:masterElement
].
newIndex ~~ 0 ifTrue:[
masterElement := list at:newIndex.
name := Text string:masterElement.
name emphasizeFrom:(1+(name leftIndent)) with:#(#bold #underline).
list at:newIndex put:name.
] ifFalse:[
masterElement := nil
].
self changed:#list.
]
! !
!UIPainterView::ListHolder methodsFor:'searching'!
detectProperty:aBlock
"find the property, for which evaluation of the argument, aBlock
returns true; return the property or nil if none detected
"
|idx|
idx := self findProperty:aBlock.
idx ~~ 0 ifTrue:[ ^ propertyList at:idx ].
^ nil
!
findParentProperty:aChildProp
"returns index of parent or 0
"
|view index|
view := aChildProp view.
view notNil ifTrue:[
[ (view := view superView) notNil ] whileTrue:[
index := self findProperty:[:aProp| aProp view == view ].
index ~~ 0 ifTrue:[
^ index
]
]
].
^ 0
!
findProperty:aBlock
"find the first property, for which evaluation of the argument, aBlock
returns true; return its index or 0 if none detected
"
^ propertyList findFirst:aBlock
!
indexOfName:aString
"returns index assigned to a string or 0
"
|name list size|
aString notNil ifTrue:[
name := aString string withoutSeparators.
size := name size.
list := self list.
list keysAndValuesDo:[:anIndex :aName|
|el|
el := aName string.
(el endsWith:name) ifTrue:[
(el size - el leftIndent) == name size ifTrue:[
^ anIndex
]
]
]
].
^ 0
!
lastInGroupStartingAt:start
"returns last index of a group
"
|end list idt|
list := self list.
start < list size ifTrue:[
idt := (list at:start) leftIndent.
end := list findFirst:[:el|(el leftIndent) <= idt] startingAt:(start+1).
end ~~ 0 ifTrue:[
^ end - 1
]
].
^ list size
! !
!UIPainterView::ListHolder methodsFor:'selection'!
selectGroup
"select all elements assigned to master
"
|start end sel size|
painter enabled ifTrue:[
(start := self masterElement) ~~ 0 ifTrue:[
end := self lastInGroupStartingAt:start.
size := end - start + 1.
sel := Array new:size.
1 to:size do:[:i|
sel at:i put:start.
start := start + 1
].
self selectionIndex:sel.
] ifFalse:[
(self selectionIndex) size == 0 ifFalse:[
self selectionIndex:#()
].
]
]
!
selectedProperty
"returns current selected instance; in case of multiple selection
or no selection nil is returned
"
|selection|
selection := self selectionIndex.
selection size == 1 ifTrue:[
propertyList size ~~ 0 ifTrue:[
^ propertyList at:(selection first)
]
].
^ nil
!
selectionIndex:aList
|masterIndex aSel|
painter enabled ifTrue:[aSel := aList]
ifFalse:[aSel := nil].
aSel size ~~ 0 ifTrue:[masterIndex := aSel at:1]
ifFalse:[masterIndex := 0].
self masterElement:masterIndex.
super selectionIndex:aSel
! !
!UIPainterView class methodsFor:'documentation'!
version
^ '$Header$'
! !