--- 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
- <resource: #keyboard ( #Copy #Paste) >
-
- 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|
-
- " <name> := <GroupClass> in:<name-of-superview>"
-
- code := ''.
-
- p := self propertyOfGroup:aGroup.
- name := p at:#variableName.
- c := ' ' , name , ' := ' , (aGroup class name) , ' new.\'.
-
- code := code , c withCRs.
-
- " <name> <symbol>:<value>"
-
- objects := p at:#controlledObjects ifAbsent:[nil].
- objects notNil ifTrue:[
- objects do:[:controlledObject |
- c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\'
- ]
- ].
-
- code := code , c withCRs
-
-
-
-
-
-!
-
-generateInitCodeForOtherStuff
- |code g c name p outlets moreCode sym typ val|
-
- code := ''.
-
- "generate code for groups"
-
- viewProperties do:[:props |
- g := props at:#group ifAbsent:[nil].
- g notNil ifTrue:[
- code := code , (self generateInitCodeForGroup:g)
- ]
- ].
- ^ code
-
-
-!
-
-generateInitCodeForView:aView
- |code c name p outlets moreCode sym typ val|
-
- " <name> := <ViewClass> in:<name-of-superview>"
-
- code := ''.
-
- p := self propertyOfView:aView.
- name := p at:#variableName.
- c := ' ' , name , ' := ' ,
- (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'.
-
- " <name> origin:(...) extent:(...)"
-
- c := c , ' ' , name , ' origin:(', aView origin printString , ')'
- , ' extent:(', aView extent printString , ').\'.
-
- moreCode := p at:#initCode ifAbsent:nil.
- moreCode notNil ifTrue:[
- c := c , moreCode , '\' withCRs
- ].
-
- code := code , c withCRs.
-
- " <name> <symbol>:<value>"
-
- outlets := p at:#outlets ifAbsent:[nil].
- outlets notNil ifTrue:[
- outlets do:[:selectorOutlet |
- sym := selectorOutlet at:#selector.
- typ := selectorOutlet at:#type.
- val := selectorOutlet at:#value.
- c := ' ' , name , ' ' , sym.
- (typ == #number) ifTrue:[
- c := c , val printString
- ].
- (typ == #string) ifTrue:[
- c := c , '''' , val , ''''
- ].
- (typ == #text) ifTrue:[
- c := c , '''' , val asString , ''''
- ].
- (typ == #strings) ifTrue:[
- c := c , '#( '.
- val asText do:[:aString |
- c := c , '''' , aString , ''' '
- ].
- c := c , ')'
- ].
- (typ == #block) ifTrue:[
- c := c , val
- ].
- (typ == #color) ifTrue:[
- c := c , '(Color name:''' , val , ''')'
- ].
- c := c , '.' , Character cr asString.
- code := code , c
- ]
- ].
-
- self subviewsOf:aView do:[:v |
- code := code , (self generateInitCodeForView:v)
- ].
- ^ code.
-
- "Modified: 5.9.1995 / 20:06:07 / claus"
-!
-
-generateInitMethod
- |defCode code|
-
- defCode := Character excla asString ,
- className , ' methodsFor:''initialization''' ,
- Character excla asString , '\\'.
-
- defCode := defCode , 'initialize\'.
- defCode := defCode , ' super initialize.\'.
- defCode := defCode , ' self setupSubViews.\'.
- defCode := defCode , ' self setupLocalStuff\'.
- defCode := defCode , Character excla asString , '\\'.
-
- defCode := defCode , 'setupSubViews\'.
- code := defCode withCRs.
-
- self subviewsOf:self do:[:v |
- code := code , (self generateInitCodeForView:v)
- ].
-
- code := code , (self generateInitCodeForOtherStuff).
-
- code := code , ' ^ self\' withCRs.
-
- defCode := Character excla asString , '\\'.
- defCode := defCode , 'setupLocalStuff\'.
- defCode := defCode , ' ^ self\'.
- defCode := defCode , Character excla asString , ' ' ,
- Character excla asString , '\\'.
-
- code := code , defCode withCRs.
- ^ code.
-
-
-
-
-!
-
-generateOutlets
- ^ self
-! !
-
-!UIPainterView methodsFor:'generating output'!
-
-generateSpecFor:something
- "generate a spec for a view or collection of views
- "
- |spec views|
-
- something notNil ifTrue:[
- something isCollection ifTrue:[views := something]
- ifFalse:[views := Array with:something].
-
- spec := views collect:[:aView||topSpec|
- aView specClass isNil ifTrue:[^ nil].
-
- topSpec := aView specClass
- fromView:aView
- callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
- topSpec
- ]
- ].
- ^ spec
-
-
-
-
-
-
-!
-
-generateWindowSpecMethodSource
- |spec specArray str code|
-
- subViews remove:inputView.
- [
- spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
- ] valueNowOrOnUnwindDo:[
- subViews addFirst:inputView.
- ].
- specArray := spec literalArrayEncoding.
-
- str := WriteStream on:String new.
- self prettyPrintSpecArray:specArray on:str indent:5.
-
- code := Character excla asString
- , className , ' class methodsFor:''interface specs'''
- , Character excla asString , '\\'
-
- , methodName , '\'
- , ' "this window spec was automatically generated by the ST/X UIPainter"\\'
- , ' "do not manually edit this - the painter/builder may not be able to\'
- , ' handle the specification if its corrupted."\\'
- , ' "\'
- , ' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\'
- , ' ' , className , ' new openInterface:#' , methodName , '\'
- , ' "\'.
-
- methodName = 'windowSpec' ifTrue:[
- code := code , ' "' , className , ' open"\'
- ].
- code := code
- , '\'
- , ' <resource: #canvas>\\'
- , ' ^\'
- , ' ', str contents
- , '\'
- , Character excla asString
- , ' '
- , Character excla asString
- , '\\'.
-
- ^ code withCRs
-
- "Modified: 5.9.1995 / 21:01:35 / claus"
-! !
-
-!UIPainterView ignoredMethodsFor:'generating output'!
-
-nameOfClass
- ^ 'NewView'
-! !
-
-!UIPainterView methodsFor:'generating output'!
-
-outletValueOf:aSymbol for:aView
-"/ |c name p outlets moreCode sym typ val|
-"/
-"/ p := self propertyOfView:aView.
-"/ outlets := p at:#outlets ifAbsent:[^ nil].
-"/ outlets notNil ifTrue:[
-"/ outlets do:[:selectorOutlet |
-"/ sym := selectorOutlet at:#selector.
-"/ (sym == aSymbol) ifTrue:[
-"/ typ := selectorOutlet at:#type.
-"/ val := selectorOutlet at:#value.
-"/ ^ val
-"/ ]
-"/ ]
-"/ ].
- ^ nil
-
-
-
-
-!
-
-prettyPrintSpecArray:spec on:aStream indent:i
- "just for your convenience: prettyPrint a specArray to aStream - it looks better that way"
-
- |what oneLine|
-
- spec isArray ifFalse:[
- spec isLiteral ifTrue:[
- aStream nextPutAll:spec storeString
- ] ifFalse:[
- self halt.
- ].
- ^ self
- ].
-
- spec isEmpty ifTrue:[
- aStream nextPutAll:'#()'.
- ^ self
- ].
-
- what := spec at:1.
- what isArray ifTrue:[
- aStream cr; spaces:i+2.
- aStream nextPutAll:'#('.
- "/ a spec-collection
- spec do:[:element |
- self prettyPrintSpecArray:element on:aStream indent:i+2.
- ].
- aStream cr.
- aStream spaces:i+1.
- aStream nextPutAll:')'.
- ^ self.
- ].
-
- oneLine := false.
- (#(#LayoutFrame #LayoutOrigin #AlignmentOrigin
- #Rectangle #Point
- #Color #ColorValue
- )
- includesIdentical:what) ifTrue:[
- oneLine := true
- ].
-
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+2.
- ].
- aStream nextPutAll:'#('.
-
-
- aStream nextPutAll:what storeString.
-
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+4.
- ].
-
- 2 to:spec size do:[:index |
- aStream space.
- self prettyPrintSpecArray:(spec at:index) on:aStream indent:i+4.
- oneLine ifFalse:[
- (index odd and:[index ~~ (spec size)]) ifTrue:[
- aStream cr; spaces:i+4.
- ]
- ]
- ].
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+1.
- ].
- aStream nextPutAll:')'.
-
- "Modified: 5.9.1995 / 17:44:20 / claus"
-!
-
-storeContentsOn:aStream
- viewProperties do:[:p| p storeOn:aStream]
-!
-
-stuffPropertiesFrom:view intoSpec:newSpec
- "stuff any additional information (held in the properties) into the spec
- which was just created from view"
-
- |props aspectSelector changeSelector labelSelector name tabable|
-
- 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$'
-! !