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