diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIPainterView.st --- 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 + + + 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| + + " := in:" + + code := ''. + + 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 + |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| + + " := in:" + + code := ''. + + 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 | + 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 + , '\' + , ' \\' + , ' ^\' + , ' ', 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$' +! !