"
COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
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.
"
"{ Package: 'stx:libtool2' }"
UIObjectView subclass:#UIPainterView
instanceVariableNames:'treeView listHolder superclassName className methodName
categoryName handleColorBlack handleColorWhite handleMasterColor'
classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances'
poolDictionaries:''
category:'Interface-UIPainter'
!
Object subclass:#ViewProperty
instanceVariableNames:'view spec identifier'
classVariableNames:'Identifier'
poolDictionaries:''
privateIn:UIPainterView
!
!UIPainterView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG
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
[author:]
Claus Gittinger
Claus Atzkern
"
! !
!UIPainterView class methodsFor:'initialization'!
initialize
AspectsAsInstances := true. "/ false.
RedefineAspectMethods := false.
"Created: / 22.9.1999 / 12:32:31 / stefan"
! !
!UIPainterView class methodsFor:'code generation mode'!
generateAspectsAsInstanceVariables
"if on, aspects are held as instance variables;
if off (the default), they are kept in the bindings dictionary.
"
^ AspectsAsInstances
"Created: / 29.7.1998 / 11:21:38 / cg"
"Modified: / 29.7.1998 / 11:22:01 / cg"
!
generateAspectsAsInstanceVariables:aBoolean
"if on, aspects are held as instance variables;
if off (the default), they are kept in the bindings dictionary.
"
AspectsAsInstances := aBoolean
"Created: / 29.7.1998 / 11:21:26 / cg"
"Modified: / 29.7.1998 / 11:22:11 / cg"
!
redefineAspectMethods
"redefine methods yes or no. If a method is defined in super class
should the message be reinstalled ?
"
^ RedefineAspectMethods
"Modified: / 22.9.1999 / 12:33:03 / stefan"
!
redefineAspectMethods:aBoolean
"redefine methods yes or no. If a method is defined in super class
should the message be reinstalled ?
"
RedefineAspectMethods := aBoolean
! !
!UIPainterView class methodsFor:'defaults'!
defaultMenuMessage
"This message is the default yo be sent to the menuHolder to get a menu
"
^ #showMiddleButtonMenu
! !
!UIPainterView methodsFor:'accessing'!
application
^ nil
"Modified: 6.9.1995 / 00:46:44 / claus"
!
applicationName
^ self className
!
applicationName:aName
self className:aName
!
class:aClass superclassName:aSuperclassName selector:aSelector
self assert:(aClass isBehavior).
className := aClass name.
superclassName := aSuperclassName.
methodName := aSelector.
!
className
^ className
!
className:aName
self assert:(aName isString).
className := aName
!
className:aClassName superclassName:aSuperclassName selector:aSelector
self assert:(aClassName isString).
className := aClassName.
superclassName := aSuperclassName.
methodName := aSelector.
!
methodName
^ methodName
!
methodName:aName
methodName := aName
!
selectNames:aStringOrCollection
|prop coll s n newSel|
(aStringOrCollection size == 0) ifTrue:[
newSel := nil.
] ifFalse:[
(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)
]
].
(n := coll size) == 1 ifTrue:[
newSel := coll at:1
] ifFalse:[
n == 0 ifTrue:[
newSel := nil
] ifFalse:[
newSel := coll
]
].
^ self select:newSel.
]
].
prop := self propertyOfName:s.
prop isNil ifTrue:[
newSel := nil
] ifFalse:[
newSel := prop view
].
].
^ self select:newSel
! !
!UIPainterView methodsFor:'change & update'!
layoutChanged
treeView notNil ifTrue:[
treeView layoutChanged
]
! !
!UIPainterView methodsFor:'copy & cut & paste'!
commonContainerOf:someComponents
|container|
container := someComponents first container.
[container notNil
and:[ (someComponents conform:[:eachComponent | eachComponent isComponentOf:container]) not]]
whileTrue:[
container := container container.
].
^ container
!
copySelection
"copy the selection into the cut & paste-buffer"
|specs coll sel|
sel := treeView selection.
coll := self minSetOfSuperViews:(self selection).
coll notNil ifTrue:[
"/ self select:nil.
specs := coll collect:[:aView| self fullSpecFor:aView ].
self setClipboardObject:specs.
"/ treeView selection: sel
].
!
deleteSelection
"delete the selection buffered"
self deleteSelectionBuffered: true
!
deleteSelectionBuffered: buffered
"cut the selection into the cut&paste-buffer
and open a transaction"
|specs coll index oldSelection newSelection treeModel children size nd|
treeView askForSelectionChangeAllowed ifFalse:[^ self].
coll := self minSetOfSuperViews:(self selection).
coll notNil ifTrue:[
treeView cvsEventsDisabledDo:[
treeModel := treeView model.
oldSelection := treeModel selectedNodes at:1 ifAbsent: nil.
oldSelection notNil ifTrue:[
children := oldSelection parent children.
(size := children size) > 1 ifTrue:[
index := children identityIndexOf:oldSelection.
size == index ifTrue:[
index := index - 1
].
newSelection := children at:index ifAbsent:1.
] ifFalse:[
newSelection := oldSelection parent
].
newSelection := treeModel indexOf:newSelection.
] ifFalse:[
newSelection := 1
].
self hideSelection.
selection := nil.
specs := coll collect:[:aView| self fullSpecFor:aView ].
self withinTransaction:#cut objects:coll do:[
coll reverseDo:[:aView|
self createUndoRemove:aView.
self remove:aView.
]
].
buffered ifTrue: [self setClipboardObject:specs].
treeView selection:nil.
treeView selection:(Array with: newSelection).
(nd := treeView selectedNode) notNil ifTrue:[
self setSelection:nd contents view withRedraw:true.
]
]
]
!
deleteTotalSelection
"delete the selection"
self deleteSelectionBuffered: false
!
getSelectedViewsAndSpecs
"return an array filed with selected views and corresponding specs.
Nil if there is none."
|specs coll sel|
sel := treeView selection.
coll := self minSetOfSuperViews:(self selection).
coll isNil ifTrue:[^ nil].
specs := coll collect:[:aView| self fullSpecFor:aView ].
^ Array with: coll with: specs
!
pasteBuffer
"add the objects in the paste-buffer to the object view"
|sel|
sel := self pasteSpecifications:(self getClipboardObject) keepLayout:false.
sel notNil ifTrue:[
self select:sel.
].
!
pasteKeepingPosition
"add the objects in the paste-buffer to the object view;
translate the layout as appropriate, to position the component
at the same absolute position (relative to topView) as before"
|sel|
sel := self
pasteSpecifications:(self getClipboardObject)
keepLayout:true
keepPosition:true
at:nil.
sel notNil ifTrue:[
self select:sel.
].
!
pasteSpecifications:aSpecificationOrList keepLayout:keepLayout
"add the specs to the object view; returns list of pasted components"
^ self
pasteSpecifications:aSpecificationOrList
keepLayout:keepLayout
at:nil
"Modified: 11.8.1997 / 01:00:35 / cg"
!
pasteSpecifications:aSpecificationOrList keepLayout:keepLayout at:aPointOrNil
"add the specs to the object view; returns list of pasted components"
^ self
pasteSpecifications:aSpecificationOrList
keepLayout:keepLayout
keepPosition:false
at:aPointOrNil
!
pasteSpecifications:aSpecificationOrList keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNil
"add the specs to the object view; returns list of pasted components"
|paste pasteOrigin pasteOffset builder newSel bounds containerToPasteInto|
treeView askForSelectionChangeAllowed ifFalse:[^ nil].
containerToPasteInto := self singleSelection.
containerToPasteInto isNil ifTrue:[
self selection size > 0 ifTrue:[
containerToPasteInto := self commonContainerOf:self selection
] ifFalse:[
containerToPasteInto := self
].
self selection:containerToPasteInto.
].
(self canPasteInto:containerToPasteInto) ifFalse:[
containerToPasteInto notNil ifTrue:[
"/ search up parent list for something we can paste into
[containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[
containerToPasteInto := containerToPasteInto container.
].
self selection:containerToPasteInto.
].
].
containerToPasteInto isNil ifTrue:[
containerToPasteInto := self
].
(self canPaste:aSpecificationOrList) ifFalse:[
Dialog warn:'Cannot paste into selected component (not a container ?)'.
^ nil
].
aSpecificationOrList isCollection ifTrue:[
paste := aSpecificationOrList
] ifFalse:[
paste := Array with:aSpecificationOrList
].
self setClipboardObject:nil.
newSel := OrderedCollection new.
builder := UIBuilder new isEditing:true.
className notNil ifTrue:[
builder applicationClass:(self resolveName:className)
].
(keepLayout not or:[keepPosition]) ifTrue:[
pasteOffset := 0@0.
keepPosition ifTrue:[
pasteOrigin := device translatePoint:0@0
fromView:self
toView:containerToPasteInto.
] ifFalse:[
aPointOrNil isNil ifTrue:[
pasteOrigin := self sensor mousePoint.
pasteOrigin := device translatePoint:pasteOrigin
fromView:nil
toView:containerToPasteInto.
] ifFalse:[
pasteOrigin := device translatePoint:aPointOrNil
fromView:self
toView:containerToPasteInto.
]
].
bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent)
].
paste do:[:aSpec|
|view newOrigin|
view := self addSpec:aSpec builder:builder in:containerToPasteInto.
keepPosition ifTrue:[
self moveObject:view to:(view origin + pasteOrigin).
] ifFalse:[
keepLayout ifFalse:[
(bounds containsPoint:pasteOrigin) ifFalse:[
newOrigin := pasteOffset.
] ifTrue:[
newOrigin := pasteOrigin + pasteOffset.
].
self moveObject:view to:newOrigin.
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]).
self undoHistoryChanged.
].
self realizeAllSubViews.
newSel do:[:v| v raise].
self elementChangedSize:containerToPasteInto.
newSel size == 1 ifTrue:[newSel := newSel at:1].
^ newSel
"Modified: / 10.10.2001 / 14:15:12 / cg"
!
pasteWithLayout
"add the objects in the paste-buffer to the object view;
don't change the layout"
|sel|
sel := self pasteSpecifications:(self getClipboardObject) keepLayout:true.
sel notNil ifTrue:[
self select:sel.
].
! !
!UIPainterView methodsFor:'drag & drop'!
canDrop:aCollectionOfDropObjects
"returns true if something can be dropped"
(aCollectionOfDropObjects size == 1 and:[self enabled and:[self numberOfSelections <= 1]]) ifTrue:[
^ aCollectionOfDropObjects first theObject isKindOf:UISpecification
].
^ false
!
canPaste
"returns true if there is something which can be pasted in the clipboard"
^ self canPaste:(self getClipboardObject)
!
canPaste:something
"returns true if something could be pasted"
|el size|
((size := self numberOfSelections) <= 1 and:[self enabled]) ifFalse:[
^ false
].
something isCollection
ifTrue:[something notEmpty ifTrue:[el := something first]]
ifFalse:[el := something].
(el isKindOf:UISpecification) ifFalse:[
^ false
].
size == 1 ifTrue:[
^ self canPasteInto:(self singleSelection)
].
^ true
!
canPasteInto:aView
"return true, if I can paste into a view"
|prop|
aView isNil ifTrue:[ ^ false ].
(prop := self propertyOfView:aView) notNil ifTrue:[
^ prop spec class supportsSubComponents
].
^ aView specClass supportsSubComponents.
!
drop:aCollectionOfDropObjects at:aPoint
|spec newSel oldSel dragOffset widg doit|
doit := true.
self selection notNil ifTrue:[
oldSel := self singleSelection.
"/ search selections hierarchy for a widget into which we can paste
widg := oldSel.
[widg isNil or:[self canPasteInto:widg]] whileFalse:[
widg notNil ifTrue:[
widg := widg container
].
].
oldSel := nil.
self setSelection:widg withRedraw:true.
].
spec := (aCollectionOfDropObjects at:1) theObject.
doit ifTrue:[
dragOffset := DragAndDropManager dragOffsetQuerySignal query.
newSel := self pasteSpecifications:spec keepLayout:false at:aPoint - dragOffset.
self select:(oldSel ? newSel)
].
"Modified: / 18.3.1999 / 18:29:43 / stefan"
"Modified: / 30.10.2001 / 14:02:35 / cg"
! !
!UIPainterView methodsFor:'event handling'!
keyPress:key x:x y:y view:aView
"a delegated keyEvent from aView"
self keyPress:key x:x y:y
"Modified: / 31.10.1997 / 20:27:22 / cg"
!
keyRelease:key x:x y:y view:aView
"a delegated keyEvent from aView"
self keyRelease:key x:x y:y
"Modified: / 31.10.1997 / 20:27:32 / cg"
!
sizeChanged:how
super sizeChanged:how.
self layoutChanged
! !
!UIPainterView methodsFor:'generating output'!
aspectMethods
"extract a list of aspect methods - for browsing"
|cls methods|
className isNil ifTrue:[
self warn:'No class defined !!'.
^ #()
].
cls := self resolveName:className.
methods := IdentitySet new.
self aspectSelectorsAndTypesDo:
[:selector :typeSymbol |
|skip|
(cls includesSelector:selector) ifTrue:[
skip := false.
(typeSymbol == #modelAspect) ifTrue:[
(cls isSubclassOf:SimpleDialog) ifTrue:[
skip := SimpleDialog includesSelector:(selector asSymbol)
].
].
skip ifFalse:[
methods add:(cls compiledMethodAt:selector)
].
]
].
^ methods
"Created: / 25.10.1997 / 18:58:25 / cg"
"Modified: / 26.10.1997 / 15:06:18 / cg"
!
aspectSelectorsAndTypesDo:aTwoArgBlock
"evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type"
|cls selector protoSpec|
className isNil ifTrue:[
self warn:'No class defined !!'.
^ self
].
cls := self resolveName:className.
treeView propertiesDo:[:aProp|
|selector|
(selector := aProp model) notNil ifTrue:[
selector isArray ifFalse:[
aTwoArgBlock value:(selector asSymbol) value:#modelAspect
].
].
(selector := aProp menu) notNil ifTrue:[
selector isArray ifFalse:[
aTwoArgBlock value:(selector asSymbol) value:#menu
].
].
(aProp spec aspectSelectors) do:[:aSel |
aSel isArray ifFalse:[
aTwoArgBlock value:(aSel asSymbol) value:#channelAspect
].
].
aProp spec actionSelectors do:[:aSel|
aSel isArray ifFalse:[
aTwoArgBlock value:(aSel asSymbol) value:#actionSelector
].
].
aProp spec valueSelectors do:[:aSel|
aSel isArray ifFalse:[
aTwoArgBlock value:(aSel asSymbol) value:#valueSelector
].
]
].
protoSpec := treeView canvasSpec.
(selector := protoSpec menu) notNil ifTrue:[
selector isArray ifFalse:[
aTwoArgBlock value:(selector asSymbol) value:#menu
].
].
!
generateActionMethodFor:aspect spec:protoSpec inClass:targetClass
|selector args showIt code alreadyInSuperclass numArgs method|
selector := aspect asSymbol.
alreadyInSuperclass := targetClass superclass canUnderstand:selector.
numArgs := selector numArgs.
method := aspect.
numArgs == 1 ifTrue:[
args := 'anArgument'.
showIt := ''' , anArgument printString , '' ...''.\'.
] ifFalse:[
args := ''.
showIt := ' ...''.\'.
numArgs ~~ 0 ifTrue:[
method := ''.
selector keywords keysAndValuesDo:[:i :key|
method := method, key, 'arg', i printString, ' '
]
]
].
code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' ,
method , args , '\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code below performs no action"\' ,
' "*** (except for some feedback on the Transcript)"\' ,
' "*** Please change as required and accept in the browser."\' ,
'\' .
alreadyInSuperclass ifTrue:[
code := code ,
' "action for ' , aspect , ' is already provided in a superclass."\' ,
' "It may be redefined here ..."\\'.
] ifFalse:[
code := code ,
' "action to be added ..."\\'.
].
code := code ,
' Transcript showCR:self class name, '': '.
alreadyInSuperclass ifTrue:[
code := code , 'inherited '.
].
code := code , 'action for ' , aspect , showIt.
alreadyInSuperclass ifTrue:[
code := code ,
' super ' , aspect , args , '.\'.
].
code := code ,
'!! !!\\'.
^ code withCRs
"Modified: / 25.10.1997 / 19:18:50 / cg"
!
generateAspectMethodCode
"generate aspect, action & menu methods
- but do not overwrite existing ones.
Return a string ready to compile into the application class."
^ self generateAspectMethodCodeFiltering:nil
!
generateAspectMethodCodeFiltering:aFilterOrEmpty
"generate aspect, action & menu methods
- but do not overwrite existing ones.
Return a string ready to compile into the application class."
|cls codePieces skip protoSpec thisCode
definedMethodSelectors iVars t exportSels|
cls := self targetClass.
cls isNil ifTrue:[
^ nil
].
codePieces := OrderedCollection new.
definedMethodSelectors := IdentitySet new.
treeView propertiesDo:[:aProp|
|modelSelector|
protoSpec := aProp spec.
(modelSelector := aProp model) notNil ifTrue:[
self generateCodeFrom:(Array with:modelSelector) in:cls
do:[:aSel|
(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
skip := false.
(cls isSubclassOf:SimpleDialog) ifTrue:[
skip := SimpleDialog includesSelector:aSel
].
(definedMethodSelectors includes:aSel) ifTrue:[
skip := true.
].
skip ifFalse:[
"/ kludge ..
"/ (protoSpec isKindOf:ActionButtonSpec)
(protoSpec defaultModelIsCallBackMethodSelector:aSel)
ifTrue:[
thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
] ifFalse:[
thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
].
codePieces add:thisCode.
definedMethodSelectors add:aSel.
Transcript showCR:'code generated for aspect: ' , aSel
] ifTrue:[
Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)'
].
].
].
].
"/ for each aspect, generate getter (if not yet implemented)
self generateCodeFrom:(aProp spec aspectSelectors) in:cls
do:[:aSel|
(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
(definedMethodSelectors includes:aSel) ifFalse:[
thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls).
codePieces add:thisCode.
definedMethodSelectors add:aSel.
Transcript showCR:'code generated for aspect: ' , aSel
]
]
].
"/ exported aspects - need setter methods
exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol].
self generateCodeFrom:exportSels in:cls
do:[:aSel|
|aspect|
(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
(definedMethodSelectors includes:aSel) ifFalse:[
aspect := (aSel copyWithoutLast:1) asSymbol.
thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls).
codePieces add:thisCode.
definedMethodSelectors add:aSel.
Transcript showCR:'export code generated for aspect: ' , aSel
]
]
].
self generateCodeFrom:(aProp spec actionSelectors) in:cls
do:[:aSel|
(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
(definedMethodSelectors includes:aSel) ifFalse:[
thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls).
codePieces add:thisCode.
definedMethodSelectors add:aSel.
Transcript showCR:'action generated for aspect: ' , aSel
]
]
].
self generateCodeFrom:(aProp spec valueSelectors) in:cls
do:[:aSel|
(aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[
(definedMethodSelectors includes:aSel) ifFalse:[
"/ uppercase: - assume its a globals name.
aSel first isUppercase ifFalse:[
thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls).
codePieces add:thisCode.
definedMethodSelectors add:aSel.
Transcript showCR:'code generated for aspect: ' , aSel
]
]
]
].
].
AspectsAsInstances ifTrue:[
iVars := cls instVarNames asOrderedCollection.
definedMethodSelectors do:[:ivar |
(iVars includes:ivar) ifFalse:[
iVars add:ivar
]
].
iVars := iVars asArray.
t := cls shallowCopy.
t setInstanceVariableString:iVars asStringCollection asString.
codePieces addFirst:(t definition , '!!\' withCRs).
].
^ String
streamContents:
[:codeStream |
codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece].
].
"Modified: / 29.7.1998 / 12:21:19 / cg"
!
generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass
|modelClass modelValueString modelValue modelGen code|
modelClass := protoSpec defaultModelClassFor:aspect.
modelValueString := protoSpec defaultModelValueStringFor:aspect.
modelValueString notNil ifTrue:[
modelGen := modelValueString
] ifFalse:[
modelValue := protoSpec defaultModelValueFor:aspect.
modelValue isNil ifTrue:[
modelGen := modelClass name , ' new'
] ifFalse:[
modelGen := modelValue storeString , ' asValue'
].
].
code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' ,
aspect , '\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code below creates a default model when invoked."\' ,
' "*** (which may not be the one you wanted)"\' ,
' "*** Please change as required and accept it in the browser."\' ,
' "*** (and replace this comment by something more useful ;-)"\' .
AspectsAsInstances ifTrue:[
code := code , '\' ,
' ' , aspect , ' isNil ifTrue:[\' ,
' ' , aspect , ' := ' , modelGen , '.\'.
modelClass ~~ TriggerValue ifTrue:[
code := code ,
'"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
'"/ ' , aspect , ' addDependent:self.\' ,
'"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'.
].
code := code ,
' ].\' ,
' ^ ' , aspect ,'.\' ,
'!! !!\\'
] ifFalse:[
code := code , '\' ,
' |holder|\' ,
'\' ,
' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' ,
' holder := ', modelGen, '.\',
' builder aspectAt:#' , aspect , ' put:holder.\'.
modelClass ~~ TriggerValue ifTrue:[
code := code ,
'"/ if your app needs to be notified of changes, uncomment one of the lines below:\' ,
'"/ holder addDependent:self.\' ,
'"/ holder onChangeSend:#', aspect ,'Changed to:self.\'.
].
code := code ,
' ].\' ,
' ^ holder.\' ,
'!! !!\\'
].
^ code withCRs
"Modified: / 29.7.1998 / 11:29:16 / cg"
"Modified: / 22.9.1999 / 12:33:47 / stefan"
!
generateAspectSelectorsMethod
"generate aspectSelectors method.
Return a string ready to compile into the application class."
|cls code spec|
cls := self targetClass.
cls isNil ifTrue:[
^ nil
].
spec := treeView exportedAspects.
spec size == 0 ifTrue:[^ nil].
"/ make it an array ...
spec := spec collect:[:entry | |subAspect type|
subAspect := entry subAspect asSymbol.
(type := entry type) isNil ifTrue:[
subAspect
] ifFalse:[
Array with:subAspect with:type asSymbol
].
].
spec := spec asArray.
code := '!!' , cls name , ' class methodsFor:''plugIn spec''!!\\' .
code := code , 'aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(\'.
spec do:[:el | code := code , (' ' , el storeString , '\') ].
code := code , ' ).\'.
code := code , '\!!\'.
code := code withCRs.
^ code
"Modified: / 18.2.2000 / 02:08:34 / cg"
!
generateAspectSetMethodFor:aspect spec:protoSpec inClass:targetClass
|code|
code := '!!' , targetClass name , ' methodsFor:''aspects - exported''!!\\' ,
aspect , ':something\' ,
' "automatically generated by UIPainter ..."\\' ,
' "This method is used when I am embedded as subApplication,"\' ,
' "and the mainApp wants to connect its aspects to mine."\'.
AspectsAsInstances ifTrue:[
code := (code , '\' ,
'"/ ' , aspect , ' notNil ifTrue:[\' ,
'"/ ' , aspect , ' removeDependent:self.\' ,
'"/ ].\' ,
' ' , aspect ,' := something.\' ,
'"/ ' , aspect ,' notNil ifTrue:[\' ,
'"/ ' , aspect , ' addDependent:self.\' ,
'"/ ].\' ,
' ^ self.\' ,
'!! !!\\')
] ifFalse:[
code := (code , '\' ,
'"/ |holder|\' ,
'\' ,
'"/ (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' ,
'"/ holder removeDependent:self.\' ,
'"/ ].\' ,
' builder aspectAt:#' , aspect , ' put:something.\',
'"/ something notNil ifTrue:[\' ,
'"/ something addDependent:self.\' ,
'"/ ].\' ,
' ^ self.\' ,
'!! !!\\')
].
^ code withCRs
"Modified: / 29.7.1998 / 11:29:16 / cg"
"Modified: / 22.9.1999 / 12:33:47 / stefan"
!
generateCodeFrom:aListOfSelectors in:aClass do:aBlock
|realSelectors redefCondition redefMessage|
realSelectors := aListOfSelectors select:[:sel | sel isArray not].
self class redefineAspectMethods ifTrue:[
redefCondition := [:cls :sel | (cls includesSelector:sel) not].
redefMessage := ' skipped - already implemented in the class'.
] ifFalse:[
redefCondition := [:cls :sel | (cls canUnderstand:sel) not].
redefMessage := ' skipped - already implemented in the class (or superclass)'.
].
realSelectors do:[:aSelector|
(redefCondition value:aClass value:aSelector) ifTrue:[
aBlock value:aSelector asSymbol
] ifFalse:[
Transcript showCR:('#' , aSelector , redefMessage)
]
]
!
generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass
^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' ,
selectorSpec , '\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code here does nothing. It is invoked when"\' ,
' "*** ' , commentWhen , '"\' ,
' "*** Please change as required and accept in the browser."\' ,
'\' ,
' "specific code to be added below ..."\' ,
' "' , (noteOrNil ? '') , '"\' ,
'\' ,
(defaultCode ? '^ self.') ,
'!! !!\\') withCRs
"Modified: / 25.10.1997 / 19:22:17 / cg"
"Created: / 31.10.1997 / 17:31:53 / cg"
!
generateHookMethods
"generate hook methods
- but do not overwrite existing ones.
Return a string ready to compile into the application class."
|cls|
cls := self targetClass.
cls isNil ifTrue:[
^ nil
].
^ self generateHookMethodsInClass:cls.
!
generateHookMethodsInClass:targetClass
|code|
code := ''.
(targetClass includesSelector:#postBuildWith:) ifFalse:[
code := code
, (self
generateHookMethodFor:'postBuildWith:aBuilder'
comment:'the widgets have been built, but before the view is opened'
note:'or after the super send'
defaultCode:' super postBuildWith:aBuilder'
inClass:targetClass)
].
(targetClass includesSelector:#postOpenWith:) ifFalse:[
code := code
, (self
generateHookMethodFor:'postOpenWith:aBuilder'
comment:'the topView has been opened, but before events are dispatched for it'
note:'or after the super send'
defaultCode:' super postOpenWith:aBuilder'
inClass:targetClass)
].
(targetClass includesSelector:#closeRequest) ifFalse:[
code := code
, (self
generateHookMethodFor:'closeRequest'
comment:'the topView has been asked to close'
note:'return without the ''super closeRequest'' to stay open'
defaultCode:' ^super closeRequest'
inClass:targetClass)
].
^ code
"Modified: / 31.10.1997 / 17:30:34 / cg"
"Created: / 31.10.1997 / 17:32:49 / cg"
!
generateMenuMethodFor:menuSel inClass:targetClass
|selector args showIt code alreadyInSuperclass numArgs method category|
selector := menuSel asSymbol.
category := UserPreferences current categoryForMenuActionsMethods.
alreadyInSuperclass := targetClass superclass canUnderstand:selector.
code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'.
selector = 'openAboutThisApplication' ifTrue:[
code := code ,
'openAboutThisApplication\' ,
' "opens an about box for this application."\\' ,
' "automatically generated by UIPainter ..."\\' ,
' |rev box myClass clsRev image msg|\\' ,
' rev := ''''.\' ,
' myClass := self class.\' ,
' (clsRev := myClass revision) notNil ifTrue:[\' ,
' rev := '' (rev: '', clsRev printString, '')''].\\' ,
' msg := Character cr asString , myClass name asBoldText, rev.\' ,
' msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' ,
' box := AboutBox title:msg.\' ,
' "/ *** add a #defaultIcon method in the class\' ,
' "/ *** and uncomment the following line:\' ,
' "/ image := self class defaultIcon.\\' ,
' image notNil ifTrue:[\' ,
' box image:image\' ,
' ].\' ,
' box label:(resources string:''About %1'' with:myClass name).\' ,
' box autoHideAfter:10 with:[].\' ,
' box showAtPointer.\' ,
'!! !!\\'.
^ code withCRs
].
selector = 'menuOpen' ifTrue:[
code := code ,
'menuOpen\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code below opens a dialog for file selection"\' ,
' "*** and invokes the #doOpen: method with the selected file."\' ,
' "*** Please change as required and accept in the browser."\\' ,
' |file|\\' ,
' file :=\' ,
' (FileSelectionBrowser\' ,
' request: ''Open''\' ,
' fileName: ''''\' ,
' "/ inDirectory: lastOpenDirectory\' ,
' withFileFilters: #(''*'')).\\' ,
' file notNil ifTrue:[\' ,
' "/ lastOpenDirectory := file asFilename directory.\' ,
' self doOpen:file\' ,
' ]\' ,
'!! !!\'.
^ code withCRs
].
numArgs := selector numArgs.
method := selector.
numArgs == 1 ifTrue:[
args := 'anArgument'.
showIt := ''' , anArgument printString , '' ...''.\'.
] ifFalse:[
args := ''.
showIt := ' ...''.\'.
numArgs ~~ 0 ifTrue:[
method := ''.
selector keywords keysAndValuesDo:[:i :key|
method := method, key, 'arg', i printString, ' '
]
]
].
code := code ,
method , args , '\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code below performs no action"\' ,
' "*** (except for some feedback on the Transcript)"\' ,
' "*** Please change as required and accept in the browser."\' ,
'\' .
alreadyInSuperclass ifTrue:[
code := code ,
' "action for ' , selector , ' is already provided in a superclass."\' ,
' "It may be redefined here ..."\\'.
] ifFalse:[
code := code ,
' "action to be added ..."\\'.
].
code := code ,
' Transcript showCR:self class name, '': '.
alreadyInSuperclass ifTrue:[
code := code , 'inherited '.
].
code := code , 'menu action for ' , selector , showIt.
alreadyInSuperclass ifTrue:[
code := code ,
' super ' , selector , args , '.\'.
].
code := code ,
'!! !!\\'.
^ code withCRs
"Created: / 23.8.1998 / 16:46:51 / cg"
"Modified: / 23.8.1998 / 18:13:05 / cg"
!
generateMenuMethods
"generate menu methods
- but do not overwrite existing ones.
Return a string ready to compile into the application class."
|cls code menuSelector thisCode
definedMethodSelectors
specArray fullSpec winSpec menuSpec
|
cls := self targetClass.
cls isNil ifTrue:[
^ nil
].
specArray := treeView generateFullSpecForComponents:#() named:nil.
fullSpec := specArray decodeAsLiteralArray.
winSpec := fullSpec window.
menuSelector := winSpec menu.
(menuSelector notNil
and:[ (cls respondsTo:menuSelector) ]) ifFalse:[
self warn:'No menu defined (yet)'.
^ nil.
].
menuSpec := cls perform:menuSelector.
menuSpec := menuSpec decodeAsLiteralArray.
definedMethodSelectors := IdentitySet new.
code := ''.
menuSpec allItemsDo:[:item |
|sel|
(sel := item value) notNil ifTrue:[
(definedMethodSelectors includes:sel) ifFalse:[
self generateCodeFrom:(Array with:sel) in:cls do:[:aSel|
thisCode := (self generateMenuMethodFor:aSel inClass:cls).
code := code, thisCode.
].
definedMethodSelectors add:sel.
].
]
].
(definedMethodSelectors includes:#menuOpen) ifTrue:[
self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel|
thisCode := (self generateMenuMethodFor:aSel inClass:cls).
code := code, thisCode.
].
].
^ code
"Created: / 23.8.1998 / 16:12:09 / cg"
"Modified: / 23.8.1998 / 18:12:23 / cg"
!
generateValueMethodFor:aspect spec:protoSpec inClass:targetClass
^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' ,
aspect , '\' ,
' "automatically generated by UIPainter ..."\\' ,
' "*** the code below returns a default value when invoked."\' ,
' "*** (which may not be the one you wanted)"\' ,
' "*** Please change as required and accept in the browser."\' ,
'\' ,
' "value to be added below ..."\' ,
' Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' ,
'\' ,
'^ nil.' ,
'!! !!\\') withCRs
"Modified: / 25.10.1997 / 19:22:17 / cg"
!
generateWindowSpecMethodSource
|spec str code category cls mthd specCode|
spec := OrderedCollection new.
self subViews do:[:aView|
|vSpec|
"/ care for wrapped views ...
vSpec := self fullSpecFor:aView.
vSpec isNil ifTrue:[
aView subViews size == 1 ifTrue:[
vSpec := self fullSpecFor:(aView subViews first).
]
].
vSpec isNil ifTrue:[
self warn:'Oops - could not create spec for some view'
].
spec add:vSpec
].
spec := treeView generateFullSpecForComponents:spec named:methodName.
str := WriteStream on:String new.
UISpecification prettyPrintSpecArray:spec on:str indent:5.
specCode := str contents.
(specCode includes:$!!) ifTrue:[
"/ oops - must be chunk format ...
str := WriteStream on:String new.
str nextPutAllAsChunk:specCode.
specCode := str contents.
].
"/ if that method already exists, do not overwrite the category
category := 'interface specs'.
cls := self resolveName:className.
cls notNil ifTrue:[
(mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[
category := mthd category.
]
].
code := '!!'
, className , ' class methodsFor:' , category storeString
, '!!' , '\\'
, methodName , '\'
, ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!')
, '\\ "\'
, (' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\').
(cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[
code := code
, (' ' , className , ' new openInterface:#' , methodName , '\').
].
code := code
,(methodName = 'windowSpec'
ifTrue:[' ' , className , ' open\'] ifFalse: [''])
, ' "\'.
code := code
, '\'
, ' <resource: #canvas>\\'
, ' ^ ' , specCode
, '\'
, '!! !!'
, '\\'.
^ code withCRs
"Modified: / 5.9.1995 / 21:01:35 / claus"
"Modified: / 15.10.1998 / 11:29:53 / cg"
!
targetClass
|cls|
className isNil ifTrue:[
self warn:'No TargetClass defined !!'.
^ nil
].
(cls := self resolveName:className) isNil ifTrue:[
self warn:('Class ', className asString, ' does not exist !!').
^ nil
].
^ cls.
! !
!UIPainterView methodsFor:'grid manipulation'!
newGrid
"define a new grid - this is a private helper which has to be
called after any change in the grid. It (re)creates the gridPixmap,
clears the view and redraws all visible objects."
|defaultViewBackground|
gridPixmap := nil.
defaultViewBackground := self class defaultViewBackgroundColor.
shown ifTrue:[
self viewBackground: (defaultViewBackground isColor
ifTrue: [defaultViewBackground]
ifFalse:[Black]).
self clear.
].
gridShown ifTrue:[
self defineGrid.
gridPixmap colorMap: (defaultViewBackground isColor
ifTrue: [Array with:defaultViewBackground with:Color darkGray]
ifFalse:[Array with:White with:Black]).
self viewBackground:gridPixmap.
].
self invalidate
! !
!UIPainterView methodsFor:'group & ungroup'!
group
self groupSelectionWithLayout: false
!
groupSelectionWithLayout: withLayout
| spec rect views box layout specs canvas view oldSelection cS nViews menu item xOffset yOffset |
menu := Menu new.
menu receiver: self.
item := MenuItem label:'Box' value:[spec := ViewSpec new].
menu addItem: item.
item := MenuItem label:'TBox' value:[spec := TBoxSpec new].
menu addItem: item.
item := MenuItem label:'FramedBox' value:[spec := FramedBoxSpec new].
menu addItem: item.
item := MenuItem label:'HorizontalPanel' value:[spec := HorizontalPanelViewSpec new].
menu addItem: item.
item := MenuItem label:'VerticalPanel' value:[spec := VerticalPanelViewSpec new].
menu addItem: item.
(MenuPanel menu: menu) startUp.
canvas := self painter.
cS := canvas getSelectedViewsAndSpecs.
cS isNil ifTrue:[^self].
views := cS first.
specs := cS last.
rect := views first frame.
2 to: views size do:[:i| rect := rect merge: (views at: i) frame].
layout := LayoutFrame leftFraction:0.0 offset: rect origin x
rightFraction:0.0 offset: rect corner x + 1
topFraction:0.0 offset: rect origin y
bottomFraction:0.0 offset:rect corner y + 1.
oldSelection := canvas selection.
canvas select: views first superView.
spec layout: layout.
spec class == VerticalPanelViewSpec ifTrue:[
spec verticalLayout: #topSpace.
spec horizontalLayout: #fit.
].
spec class == HorizontalPanelViewSpec ifTrue:[
spec verticalLayout: #fit.
spec horizontalLayout: #leftSpace.
].
box := self pasteSpecifications:spec keepLayout:true at:nil.
xOffset := box origin x.
yOffset := box origin y.
withLayout ifFalse:[
1 to: specs size do:[:i|
view := views at: i.
layout := LayoutFrame leftFraction:0.0 offset: (view origin x - xOffset)
rightFraction:0.0 offset: (view corner x - xOffset + 1)
topFraction:0.0 offset: (view origin y - yOffset )
bottomFraction:0.0 offset: (view corner y - yOffset + 1).
(specs at: i) layout: layout.
].
].
canvas selection: oldSelection.
canvas deleteSelection.
canvas selection:box.
nViews := canvas pasteSpecifications:specs keepLayout:true.
canvas selection: box.
!
groupWithLayout
self groupSelectionWithLayout: true
!
ungroup
self ungroupSelectionWithLayout: false
!
ungroupSelectionWithLayout: withLayout
| canvas cS views specs frame view layout superView|
canvas := self painter.
cS := canvas getSelectedViewsAndSpecs.
cS isNil ifTrue:[^self].
views := cS first first subViews copy.
superView := cS first first superView.
cS last first component isNil ifTrue:[^self].
cS last first component collection isEmpty ifTrue:[^self].
specs := cS last first component collection copy.
frame := cS first first frame.
canvas deleteSelection.
withLayout ifFalse:[
1 to: specs size do:[:i|
view := views at: i.
layout := LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x)
rightFraction:0.0 offset: (view corner x + frame origin x + 1)
topFraction:0.0 offset: (view origin y + frame origin y )
bottomFraction:0.0 offset: (view corner y + frame origin y + 1).
(specs at: i) layout: layout.
].
].
canvas selection: superView.
canvas pasteSpecifications:specs keepLayout:true.
canvas selection: superView.
!
ungroupWithLayout
self ungroupSelectionWithLayout: true
! !
!UIPainterView methodsFor:'initialization'!
create
"colors on device"
super create.
handleColorBlack := handleColorBlack onDevice:device.
handleColorWhite := handleColorWhite onDevice:device.
handleMasterColor := handleMasterColor onDevice:device.
!
initialize
"setup attributes
"
super initialize.
superclassName := 'ApplicationModel'.
className := 'NewApplication'.
methodName := 'windowSpec'.
categoryName := 'Applications'.
HandCursor := Cursor leftHand.
handleColorBlack := Color black.
handleColorWhite := Color white.
handleMasterColor := Color red.
self backgroundColor: self class defaultViewBackgroundColor.
!
setupFromSpec:specOrSpecArray
|spec builder|
Cursor wait showWhile: [
self removeAll.
specOrSpecArray notNil ifTrue:[
spec := UISpecification from:specOrSpecArray.
].
builder := UIBuilder new isEditing:true.
"set applicationClass, in order that subspecifications may be resolved"
className notNil ifTrue:[
builder applicationClass:(self resolveName:className).
].
spec notNil ifTrue:[
spec window setupView:self topView for:builder.
self addSpec:(spec component) builder:builder in:self.
].
self realizeAllSubViews.
spec notNil ifTrue:[
treeView setAttributesFromWindowSpec:(spec window)
].
].
!
treeView:aTreeView
treeView := aTreeView.
treeView delegate:(
"/
"/ I want to handle everything typed
"/ in the treeView, except for Return and Cursor-keys
"/
KeyboardForwarder
toView:self
condition:nil
filter:[:k | (k isSymbol
and:[k ~~ #Return
and:[k ~~ #Tab
and:[(k startsWith:#Cursor) not]]])
]
)
"Modified: / 31.10.1997 / 20:22:09 / cg"
! !
!UIPainterView methodsFor:'menus'!
showMiddleButtonMenu
"show the middle button menu; this returns nil
"
|m|
self enabled ifTrue:[
m := MenuPanel fromSpec:(UIPainter menuEdit) receiver:self superView application.
self startUpMenu:m
].
^ nil
! !
!UIPainterView methodsFor:'private-handles'!
painter
^ treeView canvas
!
showSelected:aComponent
"show object selected
"
|wasClipped sel hColor bg|
selectionHiddenLevel == 0 ifTrue:[
sel := treeView selection.
(sel size > 1 and:
[(treeView model list at: sel first) contents view == aComponent])
ifTrue: [
hColor := handleMasterColor
] ifFalse:[
bg := aComponent viewBackground.
bg isColor ifTrue:[
bg brightness < 0.5 ifTrue:[
hColor := handleColorWhite
] ifFalse:[
hColor := handleColorBlack
]
] ifFalse:[
hColor := handleColorBlack
]
].
self paint:hColor.
(wasClipped := clipChildren) ifTrue:[
self clippedByChildren:(clipChildren := false).
].
self handlesOf:aComponent do:[:aRectangle :what| |l t w h|
l := aRectangle left + 1.
t := aRectangle top + 1.
w := aRectangle width - 2.
h := aRectangle height - 2.
what == #view ifTrue:[self displayRectangleX:l y:t width:w height:h]
ifFalse:[self fillRectangleX:l y:t width:w height:h]
].
wasClipped ifTrue:[
self clippedByChildren:(clipChildren := true).
]
]
"Modified: / 6.12.2001 / 00:00:16 / cg"
! !
!UIPainterView methodsFor:'queries'!
resolveName:aName
|appl|
appl := self application.
appl notNil ifTrue:[
^ appl resolveName:aName
].
^ Smalltalk resolveName:aName inClass:self class
! !
!UIPainterView methodsFor:'removing components'!
remove:anObject
"remove anObject from the contents do redraw
"
anObject notNil ifTrue:[
treeView removeView:anObject.
]
!
removeAll
"remove all objects and properties
"
self select:nil.
treeView removeAll.
self removeUndoHistory.
! !
!UIPainterView methodsFor:'searching'!
findContainerOfView:aView
"returns the super view assigned to a view
"
|p|
(p := self propertyOfParentForView:aView) isNil ifTrue:[
^ self
].
^ p view
!
findObjectAt:aPoint
"find the origin/corner of the currentWidget
"
|view prop|
view := super findObjectAt:aPoint.
prop := self propertyOfView:view.
prop notNil ifTrue:[^ prop view].
^ nil
!
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:[
^ treeView propertyDetect:[:p| p identifier == anId ]
].
^ nil
!
propertyOfName:aString
"returns property assigned to name
"
|name|
aString isNil ifFalse:[
name := aString string withoutSeparators.
^ treeView propertyDetect:[:p| p name = name ].
].
^ nil
!
propertyOfParentForView:aSubView
"returns the property of the parent or nil
"
|item|
(item := treeView detectItemCorespondingToView:aSubView) notNil ifTrue:[
(item := item parent) notNil ifTrue:[^ item contents]
].
^ nil
!
propertyOfView:aView
"detect the property for the argument, a view. The property of the view or
the first subview providing the properties is returned. If no property is detected
nil is returned.
"
|item|
item := treeView detectItemCorespondingToView:aView.
(item notNil and:[item parent notNil]) ifTrue:[
^ item contents
].
^ nil
!
uniqueNameFor:aSpecOrString
"generate and return an unique name for a class
"
|next name size|
aSpecOrString isString ifFalse:[name := aSpecOrString userFriendlyName]
ifTrue:[name := aSpecOrString].
size := name size + 1.
next := 0.
treeView 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 basics'!
addToSelection:anObject
"add an object to the selection
"
(self enabled and:[(self isSelected:anObject) not]) ifTrue:[
selection isCollection ifFalse:[
selection isNil ifTrue:[
selection := anObject
] ifFalse:[
selection := OrderedCollection with:selection with:anObject
]
] ifTrue:[
"/ to enforce the change-message (value is identical to oldValue)
selection isList ifTrue:[
selection add:anObject
] ifFalse:[
selection := selection asOrderedCollection.
selection := selection copyWith:anObject
]
].
self showSelected:anObject.
treeView cvsSelectionAdd:anObject.
]
"Modified: / 11.2.2000 / 01:39:05 / cg"
!
removeFromSelection:anObject
"remove an object from the selection
"
(self isSelected:anObject) ifTrue:[
self showUnselected:anObject.
selection size > 1 ifTrue:[
selection isList ifTrue:[
selection remove:anObject ifAbsent:nil
] ifFalse:[
"/ to enforce the change-message (value is identical to oldValue)
selection := selection asOrderedCollection.
selection := selection copyWithout:anObject
].
self showSelection.
] ifFalse:[
selection := nil
].
treeView cvsSelectionRemove:anObject.
]
"Modified: / 11.2.2000 / 01:41:11 / cg"
!
select:something
"change selection to something
"
(self enabled and:[something ~= self selection]) ifTrue:[
something isNil
ifTrue: [treeView selection: (Array with: 1)]
ifFalse:[treeView cvsSelection:something].
self setSelection:something withRedraw:true
]
!
selectNextUpInHierarchy
| sel |
(sel := self selection) isNil ifTrue:[^self].
sel isCollection ifTrue:[
sel := self selection first.
].
sel := sel superView.
sel isNil ifTrue:[^self].
treeView cvsSelection: sel.
self selection: sel.
!
updateSelectionFromModel:aSelOrNil
"update selection from a new selection
"
|list|
selectionHiddenLevel == 0 ifTrue:[
aSelOrNil size ~~ 0 ifTrue:[
list := OrderedCollection new.
self selectionDo:[:el|
(aSelOrNil includes:el) ifFalse:[list add:el]
].
self showUnselected:list.
] ifFalse:[
self hideSelection.
]
].
self setSelection:aSelOrNil withRedraw:false.
self showSelection
! !
!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
"
|cls|
cls := self resolveName:className.
cls notNil ifTrue:[
aBuilder applicationClass:cls.
].
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)
].
treeView addProperty:p.
].
^ aSpecification buildViewWithLayoutFor:aBuilder in:aFrame.
"Modified: 4.7.1997 / 23:48:55 / cg"
!
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
!
rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil
|v builder|
(builder := aBuilderOrNil) isNil ifTrue:[
"/ create a dummy builder
builder := UIBuilder new isEditing:true.
className notNil ifTrue:[
builder applicationClass:(self resolveName:className).
].
].
aSpec class isLayoutContainer ifTrue:[
"/ TODO:
"/ go through subviews and let them resize to their default/preferred
"/ needed if we change a containers layout from fit to non-fit.
(aView subViews ? #()) do:[:aSubView |
|fix spec prop|
(prop := self propertyOfView:aSubView) notNil ifTrue:[
spec := prop spec.
spec useDefaultExtent ifTrue:[
fix := aSubView sizeFixed:false.
aSubView extent:aSubView preferredExtent.
aSubView sizeFixed:fix
]
]
].
].
aSpec needsRebuildForAttributes ifTrue:[
"/ needs a full rebuild (in case view class depends upon spec-attribute)
v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView).
v realize.
aView destroy.
device sync.
device flush.
aView becomeSameAs:v.
"/ inputView raise.
] ifFalse:[
aSpec setAttributesIn:aView with:builder.
self elementChangedSize:aView.
].
!
specFor:anObject
"returns spec assigned to an object
"
|prop spec|
(prop := self propertyOfView:anObject) isNil ifTrue:[^ nil].
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|
aSpec class == WindowSpec ifTrue:[
^ treeView canvasSpec:aSpec
].
self singleSelection notNil ifTrue:[
self withSelectionHiddenDo:[
self transaction:#specification selectionDo:[:aView|
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.
self rebuildView:aView fromSpec:aSpec withBuilder:nil.
props spec:(aSpec copy).
treeView propertyChanged:props.
]
]
]
"Modified: / 30.10.2001 / 13:59:45 / cg"
! !
!UIPainterView methodsFor:'testing'!
canChangeLayoutOfView:aView
"returns true if the view can change its layout which is dependant on
its parent view.
"
|item prnt|
( (item := treeView itemOfView:aView) isNil
or:[(prnt := item parent) isNil]
) ifTrue:[
^ false
].
^ (prnt parent isNil or:[prnt contents spec class isLayoutContainer not])
!
canExchangeSelectionLayouts
"returns true if the selection size is exactly 2
and all elements in the selection can be moved or aligned
"
selection size == 2 ifFalse:[
^ false
].
^ self canMoveOrAlignSelection
!
canKeepLayoutInSelection
"returns true if layout can be kept during a paste operation
"
|prop|
prop := self propertyOfView:(self singleSelection).
^ (prop isNil or:[prop spec class isLayoutContainer not])
!
canMove:something
"checks whether something is not nil and if all widgets derived from
something can change their layout ( move, align, ... operation ).
"
something notNil ifTrue:[
self forEach:something do:[:aView|
(self canChangeLayoutOfView:aView) ifFalse:[^ false]
].
^ true
].
^ false
!
canMoveOrAlignSelection
"returns true if a selection exists and all elements in the selection
can be moved or aligned
"
^ self canMove:(self selection)
! !
!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:aNoArgBlock
"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:aNoArgBlock.
self undoHistoryChanged.
! !
!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.
self undoHistoryChanged.
]
]
!
createUndoRemove:aView
"create undo method before deleting views
"
|prop pid|
(prop := self propertyOfView:aView) notNil ifTrue:[
(pid := self propertyOfParentForView:aView) notNil ifTrue:[
pid := pid identifier
].
undoHistory addUndoSelector:#undoRemove:
withArgs:(Array with:(self fullSpecFor:aView)
with:(prop identifier)
with:pid).
self undoHistoryChanged.
]
!
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)).
self undoHistoryChanged.
]
!
undoCreate:something
"undo method for creating or pasting an object
"
self forEach:something do:[:anId|self remove:(self findViewWithId:anId)].
!
undoHistory
^ undoHistory
"Created: / 30.10.2001 / 13:42:45 / cg"
!
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 layoutChanged.
]
!
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 isEditing:true) in:frame.
view realize.
prop := self propertyOfView:view.
prop identifier:(args at:2).
!
undoSpecModify:args
"undo method when changing a spec; see 'createUndoSpecModify:'
"
|view spec props|
props := self propertyOfIdentifier:(args at:2).
props notNil ifTrue:[
view := props view.
spec := args at:1.
props spec:spec.
self rebuildView:view fromSpec:spec withBuilder:nil.
treeView propertyChanged:props.
]
! !
!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 class methodsFor:'documentation'!
version
^ '$Header$'
! !
UIPainterView initialize!