# HG changeset patch # User ca # Date 855934370 -3600 # Node ID 3dd91a85c2439670c7655727a7e71bcfec2937b1 # Parent 877a25e8f5aa8a666fc2548c0fd8ee981c3a320f intitial checkin diff -r 877a25e8f5aa -r 3dd91a85c243 UIPainterTreeView.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/UIPainterTreeView.st Fri Feb 14 16:32:50 1997 +0100 @@ -0,0 +1,286 @@ +" + 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. +" + +ObjectView subclass:#UIPainterTreeView + instanceVariableNames:'builderView indent yPos maxX' + classVariableNames:'' + poolDictionaries:'' + category:'Interface-UIPainter' +! + +!UIPainterTreeView 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. +" +! ! + +!UIPainterTreeView class methodsFor:'startup'! + +start + |topView v| + + topView := StandardSystemView + label:'View hierarchy' + icon:(Form fromFile:'BuildTreeV.icon' resolution:100). + v := HVScrollableView for:self in:topView. + v origin:(0 @ 0) extent:(1.0 @ 1.0). + + topView realize. + ^ v scrolledView + + "BuilderTreeView start" + + +! ! + +!UIPainterTreeView methodsFor:'BuilderView interface'! + +builderView:aBuilderView + builderView := aBuilderView. + + +! + +selectName:aString + contents do:[:obj | + (obj text asString withoutSeparators = aString) ifTrue:[ + ^ self select:obj. + ] + ] + +! + +selectNameAdd:aString + contents do:[:obj | + (obj text asString withoutSeparators = aString) ifTrue:[ + ^ self addToSelection:obj. + ] + ] + + +! + +update:something + |sel| + + something == #tree ifTrue:[ + ^ self updateTree. + ]. + + something == #widgetName ifTrue:[ + self updateTree + ] ifFalse:[ + something == #selection ifFalse:[ + ^ self + ] + ]. + + sel := builderView selection. + + (sel isKindOf:Collection) ifTrue:[ + sel do:[:v | self selectNameAdd:(builderView variableNameOf:v)] + ] ifFalse:[ + self selectName:(builderView variableNameOf:sel) + ] + +! ! + +!UIPainterTreeView methodsFor:'drawing'! + +showSelected:anObject + "show an object as selected" + + |oldFg oldBg| + + oldFg := anObject foreground. + oldBg := anObject background. + anObject foreground:oldBg. + anObject background:oldFg. + anObject drawIn:self. + anObject foreground:oldFg. + anObject background:oldBg + + "Modified: 31.8.1995 / 13:52:02 / claus" +! ! + +!UIPainterTreeView methodsFor:'generating the class-tree picture'! + +addToTree:name indent:indent + |newObject| + + newObject := DrawText new. + "newObject font:font. " + newObject text:name. + newObject origin:((indent asInteger + margin) @ yPos). + newObject foreground:Color black. "/ foreground. + newObject background:Color white. "/background. + newObject linePattern:1; fillPattern:1. "/ opaque + yPos := yPos + newObject frame height. + self add:newObject. + maxX := maxX max:(newObject frame corner x). + + "Modified: 5.9.1995 / 23:54:26 / claus" +! + +addViewsToTreeFrom:aView indent:currentIndent + |name| + + name := builderView variableNameOf:aView. + self addToTree:name indent:currentIndent. + + builderView subviewsOf:aView do:[:subview | + self addViewsToTreeFrom:subview + indent:(currentIndent + indent) + ] +! + +updateTree + self removeAll. + maxX := 0. + yPos := (self verticalPixelPerMillimeter:1) rounded asInteger. + self addViewsToTreeFrom:builderView indent:(self horizontalPixelPerMillimeter:1). + self contentsChanged + + "Modified: 5.9.1995 / 23:54:35 / claus" +! ! + +!UIPainterTreeView methodsFor:'initialization'! + +initialize + super initialize. + + maxX := 0. + yPos := (self verticalPixelPerMillimeter:1) rounded asInteger. + indent := (self horizontalPixelPerMillimeter:5) rounded asInteger. + sorted := true. + pressAction := [:aPoint | self click:aPoint]. + shiftPressAction := [:aPoint | self shiftClick:aPoint] + + "Modified: 6.9.1995 / 00:11:48 / claus" +! + +initializeMiddleButtonMenu + |labels| + + labels := resources array:#( + 'inspect view' + 'inspect properties' + ). + + self middleButtonMenu:(PopUpMenu + labels:labels + selectors:#( + inspectView + inspectProps + ) + receiver:self + for:self) +! ! + +!UIPainterTreeView methodsFor:'private'! + +selectedName + selection isNil ifTrue:[^ nil]. + ^ selection text asString withoutSeparators +! + +withSelectedNameDo:aBlock + |name| + + name := self selectedName. + name notNil ifTrue:[aBlock value:name] +! ! + +!UIPainterTreeView methodsFor:'queries'! + +heightOfContents + ^ yPos + (self verticalPixelPerMillimeter:1) rounded + + "Modified: 6.9.1995 / 12:56:24 / claus" +! + +widthOfContents + ^ maxX + (self horizontalPixelPerMillimeter:1) rounded + + "Modified: 6.9.1995 / 12:56:28 / claus" +! ! + +!UIPainterTreeView methodsFor:'user interaction'! + +click:aPoint + |anObject| + + anObject := self findObjectAtVisible:aPoint. + (anObject ~~ selection) ifTrue:[ + self unselect. + anObject notNil ifTrue:[ + self select:anObject. + builderView selectName:(self selectedName) + ] ifFalse:[ + builderView selectName:'self' + ] + ] + + + + +! + +inspectProps + builderView inspectAttributes +! + +inspectView + builderView inspectSelection +! + +shiftClick:aPoint + |anObject| + + anObject := self findObjectAtVisible:aPoint. + + anObject notNil ifTrue:[ + (self isSelected:anObject) ifTrue:[ + builderView removeNameFromSelection:anObject text asString withoutSeparators + ] ifFalse:[ + builderView addNameToSelection:anObject text asString withoutSeparators + ] + ] + + + + + + +! ! + +!UIPainterTreeView class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! diff -r 877a25e8f5aa -r 3dd91a85c243 UIPainterView.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/UIPainterView.st Fri Feb 14 16:32:50 1997 +0100 @@ -0,0 +1,1260 @@ +" + 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. +" + +ViewPainterView subclass:#UIPainterView + instanceVariableNames:'fontPanel code viewProperties superclassName className methodName + categoryName' + classVariableNames:'HandCursor' + poolDictionaries:'' + category:'Interface-UIPainter' +! + +!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 methodsFor:'accessing'! + +className + ^ className + + "Modified: 5.9.1995 / 18:41:30 / claus" +! + +className:aString + className := aString + + "Modified: 5.9.1995 / 18:47:17 / claus" +! + +methodName + ^ methodName + + "Modified: 5.9.1995 / 18:41:34 / claus" +! + +methodName:aString + methodName := aString + + "Modified: 5.9.1995 / 18:47:27 / claus" +! ! + +!UIPainterView methodsFor:'builder interface'! + +application + self halt. + ^ nil + + "Modified: 6.9.1995 / 00:46:44 / claus" +! + +aspectAt:aSymbol + self halt. + ^ nil + + "Modified: 6.9.1995 / 00:45:35 / claus" +! + +createdComponent:newView forSpec:aSpec + "callBack from UISpec view building" + + |props| + + props := self propertiesForNewView:newView. + + aSpec name notNil ifTrue:[ + props name:aSpec name + ]. + + props labelSelector:(aSpec labelSelector). + props aspectSelector:(aSpec modelSelector). + + viewProperties add:props. +! ! + +!UIPainterView methodsFor:'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:'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 respondsTo:#label:) ifTrue:[ + aView label:name + ]. + aView name:name. + ^ props +! + +initializeCreatedObject:anObject + "set default properties for a created object + " + |props| + + props := self addProperties:nil for:anObject. + self undoCreate:(props identifier). +! + +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 initCode:nil. --- add user-defined init code later + + ^ props +! ! + +!UIPainterView methodsFor:'cut & paste'! + +copySelection + "copy the selection into the cut&paste-buffer + " + |tmp| + + tmp := OrderedCollection new. + + self selectionDo:[:aView||topSpec| + topSpec := aView specClass + fromView:aView + callBack:[:spec :aSubView | + aSubView geometryLayout:(aSubView geometryLayout copy) + ]. + tmp add:topSpec. + ]. + + self setSelection:tmp + +! + +pasteBuffer + "add the objects in the paste-buffer + " + + |sel| + + Transcript showCR:'pasteBuffer'. + sel := self getSelection. + self unselect. + sel do:[:aSpec | + self createFromSpec:aSpec + ] +! ! + +!UIPainterView methodsFor:'draw-object initialization'! + +setupCreatedObject + ^ self +! ! + +!UIPainterView methodsFor:'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 , '\\'. + + code := code , (defCode withCRs) + + + +! + +generateCode + code := ''. + (Smalltalk classNamed:className) isNil ifTrue:[ + self generateClassDefinition. + ]. +"/ self generateInitMethod. + code := code , self generateWindowSpec. + self generateOutlets. + + + ^ code withCRs + + "Modified: 5.9.1995 / 20:57:53 / claus" +! ! + +!UIPainterView ignoredMethodsFor:'generating output'! + +generateInitCodeForGroup:aGroup + |c name p objects outlets moreCode sym typ val| + + " := in:" + + p := self propertyOfGroup:aGroup. + name := p at:#variableName. + c := ' ' , name , ' := ' , (aGroup class name) , ' new.\'. + + code := code , c withCRs. + + " :" + + objects := p at:#controlledObjects ifAbsent:[nil]. + objects notNil ifTrue:[ + objects do:[:controlledObject | + c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\' + ] + ]. + + code := code , c withCRs + + + + + +! + +generateInitCodeForOtherStuff + |g c name p outlets moreCode sym typ val| + + "generate code for groups" + + viewProperties do:[:props | + g := props at:#group ifAbsent:[nil]. + g notNil ifTrue:[ + self generateInitCodeForGroup:g + ] + ] + + +! + +generateInitCodeForView:aView + |c name p outlets moreCode sym typ val| + + " := in:" + + p := self propertyOfView:aView. + name := p at:#variableName. + c := ' ' , name , ' := ' , + (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'. + + " 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. + + " :" + + 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 | + self generateInitCodeForView:v + ] + + "Modified: 5.9.1995 / 20:06:07 / claus" +! + +generateInitMethod + |defCode| + + 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 := code , defCode withCRs. + + self subviewsOf:self do:[:v | + self generateInitCodeForView:v + ]. + + 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 + + + + + +! ! + +!UIPainterView methodsFor:'generating output'! + +generateOutlets + ^ self +! + +generateWindowSpec + |spec specArray str| + + 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 + , '\' + , ' \\' + , ' ^\' + , ' ', str contents + , '\' + , Character excla asString + , ' ' + , Character excla asString + , '\\'. + + ^ code withCRs + + "Modified: 5.9.1995 / 21:01:35 / claus" +! + +nameOfClass + ^ 'NewView' +! + +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| + + props := self propertyOfView:view. + props isNil ifTrue:[^ self]. + + (aspectSelector := props aspectSelector) notNil ifTrue:[ + newSpec model:aspectSelector + ]. + (changeSelector := props changeSelector) notNil ifTrue:[ + newSpec change:changeSelector + ]. + (labelSelector := props labelSelector) notNil ifTrue:[ + newSpec label:labelSelector + ]. + (name := props name) notNil ifTrue:[ + newSpec name:name + ]. + +! + +subviewVariableNames + |names| + + names := ''. + viewProperties do:[:p| names := names , ' ' , (p name)]. + ^ names +! + +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'. + + pressAction := [:pressPoint | self startSelectOrMove:pressPoint]. + shiftPressAction := [:pressPoint | self startSelectMoreOrMove:pressPoint]. + motionAction := [:movePoint | true]. + releaseAction := [true]. + keyPressAction := [:key | self doKeyInput:key]. + + viewProperties := OrderedCollection new. + + HandCursor := Cursor leftHand. + + "Modified: 5.9.1995 / 19:58:06 / claus" +! + +initializeMiddleButtonMenu + |labels| + + labels := resources array:#( + 'copy' + 'cut' + 'paste' + '-' + 'save' + 'print' + '-' + 'inspect' + ). + + self middleButtonMenu:(PopUpMenu + labels:labels + selectors:#( + copySelection + deleteSelection + pasteBuffer + nil + save + print + nil + inspectSelection + ) + receiver:self + for:self) + +! ! + +!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 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 +! + +aspectSelectorForView:aView + |props aspect| + + props := self propertyOfView:aView. + props isNil ifTrue:[^ nil]. + ^ props aspectSelector + +! + +changeSelectorForView:aView + |props aspect| + + props := self propertyOfView:aView. + props isNil ifTrue:[^ nil]. +"/ ^ props changeSelector + ^ nil +! + +createFromSpec:specOrSpecArray + |spec builder v| + + spec := UISpecification from:specOrSpecArray. + + builder := UIBuilder new. + builder componentCreationHook:[:view :spec :aBuilder | + self createdComponent:view forSpec:spec + ]. + builder applicationClass:(Smalltalk classNamed:className). + v := spec buildViewWithLayoutFor:builder in:self. + self realizeAllSubViews. + inputView raise. + + self changed:#tree. + + + "Modified: 5.9.1995 / 23:36:55 / claus" +! + +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 + ] +! + +setAspectSelector:aspectSymbol forView:aView + |props| + + props := self propertyOfView:aView. + + undoHistory transactionNamed:'aspect' do:[ + self selectionDo:[:aView| + undoHistory isTransactionOpen ifTrue:[ + |oldAspect| + + oldAspect := props aspectSelector. + undoHistory addUndoBlock:[ + props aspectSelector:oldAspect. + self elementChanged:aView. + ] + ]. + ]. + ]. + + props aspectSelector:aspectSymbol + +! + +setChangeSelector:changeSymbol forView:aView + |props| + + props := self propertyOfView:aView. + props changeSelector:changeSymbol + +! + +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:'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 + + + +! + +propertyOf:something + + ^ viewProperties detect:[:p| (p view == something or:[p group == something])] + ifNone:nil + + + + + +! + +propertyOfGroup:aGroup + + ^ viewProperties detect:[:p| p group == aGroup] ifNone:nil +! + +propertyOfName:aString + + aString = 'self' ifFalse:[ + ^ viewProperties detect:[:p| p name = aString] ifNone:nil + ]. + ^ nil +! + +propertyOfView:aView + + aView == self ifFalse:[ + ^ viewProperties detect:[:p| p view == aView] ifNone:nil + ]. + ^ nil +! + +removePropertyOf:aView + |p| + + p := self propertyOf:aView. + p notNil ifTrue:[viewProperties remove:p] + + +! + +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:'private undo-actions'! + +undoCreate:aViewIdentifier + + undoHistory isTransactionOpen ifTrue:[ + undoHistory addUndoBlock:[ + |p| + + p := viewProperties detect:[:p| p identifier == aViewIdentifier] + ifNone:nil. + + p notNil ifTrue:[ + self removeObject:(p view) + ] + ] + ] +! + +undoRemove:propertyOfView + |clsName layout parent aView| + + undoHistory isTransactionOpen ifFalse:[ + ^ self + ]. + + aView := propertyOfView view. + clsName := aView class. + layout := aView geometryLayout. + parent := aView superView. + + parent ~~ self ifTrue:[ + parent := (self propertyOf:parent) identifier. + ] ifFalse:[ + parent := nil + ]. + + propertyOfView view:nil. + + undoHistory addUndoBlock:[ + |recreatedView props| + + parent notNil ifTrue:[ + props := viewProperties detect:[:p| p identifier == parent] ifNone:nil. + + props notNil ifTrue:[parent := props view] + ifFalse:[parent := self] + ] ifFalse:[ + parent := self + ]. + + recreatedView := clsName in:parent. + recreatedView geometryLayout:layout. + propertyOfView view:recreatedView. + self addProperties:propertyOfView for:recreatedView. + recreatedView realize. + inputView raise. + self changed:#tree. + ]. + aView := nil. + +! ! + +!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 + + "Modified: 5.9.1995 / 23:39:08 / claus" +! + +removeObject:anObject + "remove the argument, anObject" + + self removeTreeFrom:anObject. + self changed:#tree + + "Modified: 5.9.1995 / 20:51:28 / claus" +! + +removeTreeFrom:anObject + "remove the argument, anObject and all of its children + " + anObject isNil ifTrue:[ + ^ self + ]. + + (anObject subViews notNil) ifTrue:[ + anObject subViews copy do:[:sub | + self removeTreeFrom:sub + ] + ]. + + self undoRemove:(self propertyOf:anObject). + self removePropertyOf:anObject. + anObject destroy +! ! + +!UIPainterView methodsFor:'selections'! + +addNameToSelection:aString + |prop| + + prop := self propertyOfName:aString. + + prop notNil ifTrue:[ + self addToSelection:(prop view) + ] + +! + +removeNameFromSelection:aString + |prop| + + prop := self propertyOfName:aString. + + prop notNil ifTrue:[ + self removeFromSelection:(prop view) + ] + +! + +selectName:aString + |prop| + + prop := self propertyOfName:aString. + + prop notNil ifTrue:[ + self select:(prop view) + ] ifFalse:[ + self unselect + ] +! ! + +!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:ScrollBar) ifTrue:[ + ^ aComponent orientation == #vertical + ]. + (aComponent isKindOf:Scroller) ifTrue:[ + ^ aComponent orientation == #vertical + ]. + (aComponent isKindOf:Slider) ifTrue:[ + ^ aComponent orientation == #vertical + ]. + ^ true + + +! ! + +!UIPainterView class methodsFor:'documentation'! + +version + ^ '$Header$' +! !