diff -r 668eb9eae2ac -r 0a2b2ff030a0 UIPainterView.st --- a/UIPainterView.st Fri Feb 21 20:33:57 1997 +0100 +++ b/UIPainterView.st Tue Feb 25 14:15:56 1997 +0100 @@ -1,1731 +1,12 @@ -" - COPYRIGHT (c) 1995 by Claus Gittinger - All Rights Reserved - - This software is furnished under a license and may be used - only in accordance with the terms of that license and with the - inclusion of the above copyright notice. This software may not - be provided or otherwise made available to, or used by, any - other person. No title to or ownership of the software is - hereby transferred. -" - -UIObjectView subclass:#UIPainterView - instanceVariableNames:'fontPanel viewProperties superclassName className methodName - categoryName' - classVariableNames:'HandCursor' - poolDictionaries:'' - category:'Interface-UIPainter' -! - Object subclass:#ViewProperty instanceVariableNames:'aspectSelector changeSelector nameIndex view elementClass - labelSelector identifier tabable' + labelSelector identifier tabable defaultable menuSelector + initiallyInvisible' classVariableNames:'Identifier' poolDictionaries:'' 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:'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 -! - -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 -! - -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 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| - - 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 - ]. - (tabable := props tabable) notNil ifTrue:[ - newSpec tabable:tabable - ]. - (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" -! - -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 -! - -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 tabable:(aSpec tabable). - - 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 - ] -! - -setAspectSelector:aspectSymbol forView:aView - |props| - - props := self propertyOfView:aView. - - props notNil ifTrue:[ - self transaction:#aspect selectionDo:[:aView| - |oldAspect| - - oldAspect := props aspectSelector. - - undoHistory addUndoBlock:[ - props aspectSelector:oldAspect. - aView superView sizeChanged:nil - ] - ]. - props aspectSelector:aspectSymbol - ] -! - -setChangeSelector:changeSymbol forView:aView - |props| - - props := self propertyOfView:aView. - props notNil ifTrue:[ - 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:'menu & submenus'! - -menu - testMode ifFalse:[ - selection notNil ifTrue:[^ self menuSelection ] - ifFalse:[^ self menuPainter ] - ]. - ^ nil -! - -menuPainter - "menu in case of non empty selection; for views - " - |menu gridMenu| - - menu := PopUpMenu labels:( - resources array:#( - 'paste' - '-' - 'undo' - 'delete undo history' - '-' - 'grid' - ) - ) - selectors:#( - #pasteBuffer - nil - #undo - #undoDeleteAll - nil - #grid - ) - accelerators:#( - #Paste - nil - nil - nil - nil - nil - ) - receiver:self. - - (self canPaste:(self getSelection)) ifFalse:[ - menu disable:#pasteBuffer - ]. - - undoHistory isEmpty ifTrue:[ - menu disable:#undo - ] ifFalse:[ - menu subMenuAt:#undo put:(undoHistory popupMenu) - ]. - - gridMenu := PopUpMenu labels:( - resources array:#( - '\c show' - '\c align' - ) - ) - selectors:#( - #gridShown: - #gridAlign: - ). - - gridMenu checkToggleAt:#gridShown: put:(self gridShown). - gridMenu checkToggleAt:#gridAlign: put:aligning. - menu subMenuAt:#grid put:gridMenu. - - ^ menu - - -! - -menuSelection - "menu in case of non empty selection; for views - " - |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. - - ( (self canPaste:(self getSelection)) - 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:'menu actions'! - -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 - " - |specs text| - - self numberOfSelections ~~ 0 ifTrue:[ - specs := self generateSpecFor:selection. - text := self transactionTextFor:selection. - - undoHistory transaction:#cut text:text do:[ - super deleteSelection - ]. - self setSelection:specs - ] -! - -gridAlign:aBool - aBool ifTrue:[self alignOn] - ifFalse:[self alignOff] -! - -gridShown:aBool - aBool ifTrue:[self showGrid] - ifFalse:[self hideGrid] - -! - -lowerSelection - - self selectionDo:[:aView| aView lower ]. -! - -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| - |v org| - - builder componentCreationHook:[:view :spec :aBuilder | - self createdComponent:view forSpec:spec builder:aBuilder. - ]. - builder applicationClass:(Smalltalk classNamed:className). - v := aSpec buildViewWithLayoutFor:builder in:frame. - - (frame bounds containsPoint:pasteOrigin) ifFalse:[ - self moveObject:v to:pasteOffset. - ] ifTrue:[ - self moveObject:v to:pasteOrigin + pasteOffset. - ]. - - v realize. - selection add:v. - - 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 - -! - -raiseSelection - - self selectionDo:[:aView| - aView raise. - inputView raise. - ]. - -! ! - -!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" - - 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 - " - |props| - - anObject notNil ifTrue:[ - (anObject subViews notNil) ifTrue:[ - anObject subViews copy do:[:sub | - self removeTreeFrom:sub - ] - ]. - props := self propertyOf:anObject. - - props notNil ifTrue:[ - self undoRemove:props. - viewProperties remove:props - ]. - 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 -! ! - -!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:anIdentifier - - ^ viewProperties detect:[:p| p identifier == anIdentifier] 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 -! ! - -!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 & undo'! - -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 == 0 ifTrue:[^ nil]. - size ~~ 1 ifTrue:[^ 'a collection']. - - props := self propertyOfView:(anElementOrCollection at:1). - ] ifFalse:[ - props := self propertyOfView:anElementOrCollection - ]. - props notNil ifTrue:[ ^ props name ] - ]. - ^ nil -! - -undoCreate:aViewIdentifier - - undoHistory isTransactionOpen ifTrue:[ - undoHistory addUndoBlock:[ - |props| - - props := self propertyOfIdentifier:aViewIdentifier. - - props notNil ifTrue:[ - self removeObject:(props view) - ] - ] - ] -! - -undoRemove:propertyOfView - |clsName layout parent aView| - - (propertyOfView notNil and:[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 := self propertyOfIdentifier:parent. - - 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. - ]. - aView := nil. - -! ! - -!UIPainterView methodsFor:'update from Specification'! - -updateFromSpec:aSpec - "update current selected view from specification - " - self singleSelection notNil ifTrue:[ - self selectionHiddenDo:[ - self transaction:#specification selectionDo:[:aView| - |spec builder| - - spec := (self generateSpecFor:aView) first. - - undoHistory addUndoBlock:[ - builder := UIBuilder new. - spec setAttributesIn:aView with:builder. - aView superView sizeChanged:nil - ]. - builder := UIBuilder new. - aSpec setAttributesIn:aView with:builder. - aView superView sizeChanged:nil. - (self propertyOfView:aView) tabable:aSpec tabable. - ]. - self changed:#tree - ] - ] - -! ! - !UIPainterView::ViewProperty class methodsFor:'instance creation'! new @@ -1759,6 +40,16 @@ changeSelector := something.! +defaultable + "return the value of the instance variable 'defaultable' (automatically generated)" + + ^ defaultable! + +defaultable:something + "set the value of the instance variable 'defaultable' (automatically generated)" + + defaultable := something.! + elementClass "return the value of the instance variable 'elementClass' (automatically generated)" @@ -1779,6 +70,16 @@ ^ identifier ! +initiallyInvisible + "return the value of the instance variable 'initiallyInvisible' (automatically generated)" + + ^ initiallyInvisible! + +initiallyInvisible:something + "set the value of the instance variable 'initiallyInvisible' (automatically generated)" + + initiallyInvisible := something.! + labelSelector "return the value of the instance variable 'labelSelector' (automatically generated)" @@ -1789,6 +90,16 @@ labelSelector := something.! +menuSelector + "return the value of the instance variable 'menuSelector' (automatically generated)" + + ^ menuSelector! + +menuSelector:something + "set the value of the instance variable 'menuSelector' (automatically generated)" + + menuSelector := something.! + name "return the value of the instance variable 'name' (automatically generated)" @@ -1838,30 +149,3 @@ 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$' -! !