--- a/UIObjectView.st Fri Feb 14 18:20:05 1997 +0100
+++ b/UIObjectView.st Sat Feb 15 19:14:01 1997 +0100
@@ -1,7 +1,7 @@
ObjectView subclass:#UIObjectView
instanceVariableNames:'inputView testMode undoHistory copiedExtent resizedObject
resizeSelector createInWidget createFrame createdObject
- createClass'
+ createClass clipChildren'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
@@ -109,139 +109,6 @@
! !
-!UIObjectView methodsFor:'cut & paste'!
-
-convertForPaste:something
- Transcript showCR:'convertForPaste'.
- ^ nil
-
-
-!
-
-deleteSelection
- "delete the selection
- "
- undoHistory transactionNamed:'delete' do:[
- super deleteSelection
- ].
-
-! !
-
-!UIObjectView methodsFor:'dragging object move'!
-
-doObjectMove:aPoint
- "move selection
- "
-
- selection isCollection ifTrue:[^ self].
-
- movedObject isNil ifTrue:[
- (movedObject := selection) isNil ifTrue:[
- ^ self
- ].
- super unselect.
- moveDelta := aPoint - movedObject computeOrigin.
- self invertOutlineOf:movedObject
- ].
-
- self moveObject:movedObject to:(aPoint - moveDelta)
-
-
-!
-
-endObjectMove
- "cleanup after object move"
-
- movedObject notNil ifTrue:[
- self invertOutlineOf:movedObject.
- self setDefaultActions.
- self select:movedObject.
- movedObject := nil
- ].
-
- "Modified: 5.9.1995 / 12:20:31 / claus"
-
-
-!
-
-startObjectMove:aView at:aPoint
-
- super startObjectMove:aView at:aPoint.
-
- aView notNil ifTrue:[
- undoHistory transactionNamed:'move' do:[
- self undoBlockPositionChanged:aView
- ]
- ]
-
-
-!
-
-startSelectMoreOrMove:aPoint
- "add/remove to/from selection"
-
- |anObject|
-
- testMode ifTrue:[^ self].
-
- anObject := self findObjectAtVisible:aPoint.
- anObject notNil ifTrue:[
- (self isSelected:anObject) ifTrue:[
- self removeFromSelection:anObject
- ] ifFalse:[
- self addToSelection:anObject
- ]
- ]
-!
-
-startSelectOrMove:aPoint
- "a button is pressed at a point
- "
- |anObject b|
-
- testMode ifTrue:[^ self].
-
- "if there is one selection and point hits handle, start a resize
- "
- self singleSelection notNil ifTrue:[
- b := self whichHandleOf:selection isHitBy:aPoint.
-
- (b notNil and:[b ~~ #view]) ifTrue:[
- ^ self startResizeBorder:b of:selection at:aPoint.
- ]
- ].
-
- anObject := self findObjectAtVisible:aPoint.
-
- "nothing is selected
- "
- anObject isNil ifTrue:[
- ^ self unselect
- ].
-
- "object not in selection; clear selection and add anObject to selection
- "
- (self isSelected:anObject) ifFalse:[
- super unselect.
- self select:anObject.
- ] ifTrue:[
- selection isCollection ifTrue:[
- ^ self removeFromSelection:anObject.
- ]
- ].
-
- "prepare move operation for an object
- "
- motionAction := [:movePoint|
- (aPoint dist:movePoint) > 2.0 ifTrue:[
- self startObjectMove:anObject at:aPoint
- ]
- ].
- releaseAction := [self setDefaultActions].
-
-
-! !
-
!UIObjectView methodsFor:'event handling'!
doKeyInput:key
@@ -346,6 +213,8 @@
inputView enableButtonEvents.
inputView enableButtonMotionEvents.
+ self setDefaultActions.
+
undoHistory := UndoHistory new.
undoHistory modifiedAction:[:what|
@@ -353,6 +222,7 @@
].
testMode := false.
+ clipChildren := true.
(self class gridShown) ifTrue:[
super showGrid
@@ -378,20 +248,38 @@
!
invertOutlineOf:anObject
- |delta|
+ |wasClipped delta|
- self clippedByChildren:false.
+ (wasClipped := clipChildren) ifTrue:[
+ self clippedByChildren:(clipChildren := false).
+ ].
delta := (anObject originRelativeTo:self) - anObject origin.
+
self xoring:[
self displayRectangle:((anObject origin + delta) extent:anObject extent).
].
- self clippedByChildren:true.
+
+ wasClipped ifTrue:[
+ self clippedByChildren:(clipChildren := true).
+ ].
"Modified: 5.9.1995 / 12:25:25 / claus"
!
+setDefaultActions
+
+ pressAction := [:pressPoint | self startSelectOrMove:pressPoint].
+ shiftPressAction := [:pressPoint | self startSelectMoreOrMove:pressPoint].
+ motionAction := [:movePoint | nil].
+ releaseAction := [nil].
+ keyPressAction := [:key | self doKeyInput:key].
+
+ self cursor:Cursor normal.
+
+!
+
showDragging:something offset:anOffset
"drag around a View"
@@ -429,60 +317,57 @@
endCreate
"end a widget create drag
"
+ |layout x y|
+
self invertOutlineOf:createdObject.
- self cursor:oldCursor.
inputView raise.
- createdObject geometryLayout:(createdObject bounds asLayout).
+ layout := createdObject bounds asLayout.
+ createdObject geometryLayout:layout.
self changed:#tree.
self select:createdObject.
createdObject := nil.
- pressAction := [:pressPoint | self startSelectOrMove:pressPoint].
- motionAction := [:movePoint | true].
- releaseAction := [ true ].
-
- self cursor:Cursor normal.
-
+ self setDefaultActions.
!
-initializeCreatedObject:anObject
+setupCreatedObject:anObject
self subclassResponsibility
!
startCreate:aPoint
"start a widget create
"
- |props index startPoint|
+ |startPoint|
createClass isNil ifTrue:[
- ^ self
+ ^ self setDefaultActions
+ ].
+ (selection isKindOf:Collection) ifTrue:[
+ self unselect.
+ ^ self setDefaultActions.
].
startPoint := self alignToGrid:aPoint.
- motionAction := [:movePoint | self doDragCreate:movePoint].
- releaseAction := [self endCreate].
+ motionAction := [:movePoint| self doDragCreate:movePoint].
+ releaseAction := [ self endCreate].
- (selection isNil or:[selection isKindOf:Collection]) ifTrue:[
- createInWidget := self findObjectIn:self at:aPoint
- ] ifFalse:[
- createInWidget := self findObjectIn:selection at:aPoint
+ selection notNil ifTrue:[
+ ( (self isPoint:aPoint containedIn:selection)
+ and:[selection specClass basicNew supportsSubComponents]
+ ) ifFalse:[
+ self unselect
+ ]
].
- super unselect.
- self select:createInWidget.
oldCursor := cursor.
self cursor:(Cursor leftHand).
- createInWidget isNil ifTrue:[
- createdObject := createClass in:self.
- createInWidget := self.
- ] ifFalse:[
- createdObject := createClass new.
- createInWidget addSubView:createdObject.
- ].
+ createInWidget := selection ? self.
+ createdObject := createClass new.
+ createInWidget addSubView:createdObject.
createFrame := Rectangle origin:(startPoint - (createInWidget originRelativeTo:self))
corner:startPoint.
@@ -490,12 +375,138 @@
createdObject origin:(createFrame origin).
undoHistory transactionNamed:'create' do:[
- self initializeCreatedObject:createdObject.
+ self setupCreatedObject:createdObject.
].
createdObject realize.
self invertOutlineOf:createdObject.
! !
+!UIObjectView methodsFor:'object moving'!
+
+doObjectMove:aPoint
+ "move selection
+ "
+ movedObject notNil ifTrue:[
+ movedObject keysAndValuesDo:[:nr :aView|
+ self invertOutlineOf:aView.
+ self moveObject:aView to:(aPoint - (moveDelta at:nr)).
+ self invertOutlineOf:aView.
+ ]
+ ]
+
+!
+
+endObjectMove
+ "cleanup after object move"
+
+ movedObject notNil ifTrue:[
+ movedObject do:[:aView|
+ self invertOutlineOf:aView
+ ].
+
+ movedObject do:[:aView|
+ self showSelected:aView
+ ].
+ movedObject size == 1 ifTrue:[
+ selection := movedObject at:1
+ ] ifFalse:[
+ selection := movedObject
+ ].
+
+ movedObject := nil.
+ self setDefaultActions.
+ self changed:#layout.
+ ].
+!
+
+startObjectMoveAt:aPoint
+
+ self startObjectMove:selection at:aPoint.
+
+ selection size == 0 ifTrue:[
+ movedObject := Array with:selection
+ ] ifFalse:[
+ movedObject := selection
+ ].
+ super unselect.
+
+ moveDelta := movedObject collect:[:aView|
+ aPoint - aView computeOrigin
+ ].
+
+ undoHistory transactionNamed:'move' do:[
+ movedObject do:[:aView|
+ self invertOutlineOf:aView.
+ self undoBlockPositionChanged:aView
+ ]
+ ]
+!
+
+startSelectMoreOrMove:aPoint
+ "add/remove to/from selection"
+
+ |anObject|
+
+ testMode ifTrue:[^ self].
+
+ anObject := self findObjectAt:aPoint.
+ anObject notNil ifTrue:[
+ (self isSelected:anObject) ifTrue:[
+ self removeFromSelection:anObject
+ ] ifFalse:[
+ self addToSelection:anObject
+ ]
+ ]
+!
+
+startSelectOrMove:aPoint
+ "a button is pressed at a point
+ "
+ |anObject b|
+
+ testMode ifTrue:[^ self].
+
+ "if there is one selection and point hits handle, start a resize
+ "
+ self singleSelection notNil ifTrue:[
+ b := self whichHandleOf:selection isHitBy:aPoint.
+
+ (b notNil and:[b ~~ #view]) ifTrue:[
+ ^ self startResizeBorder:b of:selection at:aPoint.
+ ]
+ ].
+
+ anObject := self findObjectAt:aPoint.
+
+ "nothing is selected
+ "
+ anObject isNil ifTrue:[
+ ^ self unselect
+ ].
+
+ (self isSelected:anObject) ifFalse:[
+ super unselect.
+ self select:anObject.
+ ].
+
+ selection isCollection ifTrue:[
+ releaseAction := [
+ self setDefaultActions.
+ self select:anObject
+ ]
+ ] ifFalse:[
+ releaseAction := [self setDefaultActions]
+ ].
+
+ "prepare move operation for an object
+ "
+ motionAction := [:movePoint|
+ (aPoint dist:movePoint) > 2.0 ifTrue:[
+ self startObjectMoveAt:aPoint
+ ]
+ ].
+! !
+
!UIObjectView methodsFor:'private handles'!
handlesOf:aComponent do:aBlock
@@ -538,32 +549,41 @@
!
showSelected:aComponent
- |delta oldPaint|
+ |wasClipped delta oldPaint|
+
+ self paint:Color black.
- self paint:Color black.
- self clippedByChildren:false.
+ (wasClipped := clipChildren) ifTrue:[
+ self clippedByChildren:(clipChildren := false).
+ ].
self handlesOf:aComponent do:[:pnt :what |
what == #view ifTrue:[self displayRectangle:(pnt - (4@4) extent:7@7)]
ifFalse:[self fillRectangle:(pnt - (4@4) extent:7@7)]
].
- self clippedByChildren:true.
+ wasClipped ifTrue:[
+ self clippedByChildren:(clipChildren := true).
+ ].
self paint:oldPaint.
!
showUnselected:aComponent
- |delta r oldPaint|
+ |wasClipped delta r oldPaint|
r := aComponent origin extent:8@8.
- self clippedByChildren:false.
+ (wasClipped := clipChildren) ifTrue:[
+ self clippedByChildren:(clipChildren := false).
+ ].
self handlesOf:aComponent do:[:pnt :what |
self clearRectangle:(pnt - (4@4) extent:7@7).
].
- self clippedByChildren:true.
+ wasClipped ifTrue:[
+ self clippedByChildren:(clipChildren := true).
+ ].
"/ must redraw all components which are affected b the handles
@@ -717,43 +737,39 @@
!UIObjectView methodsFor:'searching'!
findObjectAt:aPoint
- "find the origin/corner of the currentWidget"
+ "find the origin/corner of the currentWidget
+ "
+ |view viewId lastId point|
+
+ viewId := rootView id.
+ point := aPoint + (device translatePoint:0@0 from:(self id) to:viewId).
+
+ inputView lower.
- selection notNil ifTrue:[
- (selection isKindOf:Collection) ifTrue:[
- ^ self findObjectIn:(selection first) at:aPoint
- ].
- ^ self findObjectIn:selection at:aPoint
- ].
- ^ self findObjectIn:self at:aPoint
+ [viewId notNil] whileTrue:[
+ lastId := viewId.
+ viewId := device viewIdFromPoint:point in:lastId
+ ].
+ inputView raise.
+
+ view := device viewFromId:lastId.
+
+ view ~~ inputView ifTrue:[^ view]
+ ifFalse:[^ nil]
!
-findObjectIn:aView at:aPoint
- "find the origin/corner of the currentWidget
+isPoint:aPoint containedIn:aView
+ "checks whether a point is covered by a view.
"
- |relPoint|
-
- aView isNil ifTrue:[^ nil].
- aView subViews notNil ifTrue:[
- relPoint := aPoint - (aView originRelativeTo:self).
- self subviewsOf:aView do:[:aView |
- |org ext|
+ |org ext|
- (aView isKindOf:InputView) ifFalse:[
- org := aView computeOrigin.
- ext := aView computeExtent.
- ((org extent:ext) containsPoint:relPoint) ifTrue:[
- ^ aView
- ]
- ]
- ]
- ].
- (aView == self) ifTrue:[^ nil].
+ org := aView computeOrigin.
+ ext := aView computeExtent.
- ^ self findObjectIn:(aView superView) at:aPoint
+ ^ ((org extent:ext) containsPoint:aPoint)
!
whichBorderOf:aView isHitBy:aPoint
@@ -785,10 +801,8 @@
addToSelection:something
(testMode or:[something == selection]) ifFalse:[
- selection ~~ something ifTrue:[
- super addToSelection:something.
- self changed:#selection.
- ]
+ super addToSelection:something.
+ self changed:#selection.
]
!
@@ -1060,8 +1074,6 @@
|dX dY org delta|
anObject notNil ifTrue:[
- self invertOutlineOf:anObject.
-
org := anObject computeOrigin.
delta := aPoint - org.
@@ -1073,7 +1085,6 @@
self shifLayout:anObject top:dY bottom:dY left:dX right:dX
].
self elementChangedLayout:anObject.
- self invertOutlineOf:anObject.
]
!
--- a/UIPainterView.st Fri Feb 14 18:20:05 1997 +0100
+++ b/UIPainterView.st Sat Feb 15 19:14:01 1997 +0100
@@ -1,31 +1,3 @@
-"
- 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 code viewProperties superclassName className methodName
- categoryName'
- classVariableNames:'HandCursor'
- poolDictionaries:''
- category:'Interface-UIPainter'
-!
-
-Object subclass:#ViewProperty
- instanceVariableNames:'aspectSelector changeSelector name nameIndex view elementClass
- labelSelector identifier'
- classVariableNames:'Identifier'
- poolDictionaries:''
- privateIn:UIPainterView
-!
-
UIPainterView::ViewProperty subclass:#GroupProperties
instanceVariableNames:'controlledObjects group'
classVariableNames:''
@@ -33,1341 +5,6 @@
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 methodsFor:'accessing'!
-
-className
- ^ className
-
- "Modified: 5.9.1995 / 18:41:30 / claus"
-!
-
-className:aString
- className := aString
-
- "Modified: 5.9.1995 / 18:47:17 / claus"
-!
-
-methodName
- ^ methodName
-
- "Modified: 5.9.1995 / 18:41:34 / claus"
-!
-
-methodName:aString
- methodName := aString
-
- "Modified: 5.9.1995 / 18:47:27 / claus"
-! !
-
-!UIPainterView methodsFor:'builder interface'!
-
-application
- self halt.
- ^ nil
-
- "Modified: 6.9.1995 / 00:46:44 / claus"
-!
-
-aspectAt:aSymbol
- self halt.
- ^ nil
-
- "Modified: 6.9.1995 / 00:45:35 / claus"
-!
-
-createdComponent:newView forSpec:aSpec
- "callBack from UISpec view building"
-
- |props|
-
- props := self propertiesForNewView:newView.
-
- aSpec name notNil ifTrue:[
- props name:aSpec name
- ].
-
- props labelSelector:(aSpec labelSelector).
- props aspectSelector:(aSpec modelSelector).
-
- viewProperties add:props.
-! !
-
-!UIPainterView methodsFor:'code manipulation'!
-
-changeClass
- |box classNameHolder superclassNameHolder|
-
- classNameHolder := (className ? 'MyClass') asValue.
- superclassNameHolder := (superclassName ? 'ApplicationModel') asValue.
-
- box := DialogBox new.
- box addTextLabel:'class:'.
- box addInputFieldOn:classNameHolder.
- box addTextLabel:'super class:'.
- box addInputFieldOn:superclassNameHolder.
- box addAbortButton; addOkButton.
-
- box open.
-
- box accepted ifTrue:[
- className := classNameHolder value.
- superclassName := superclassNameHolder value.
- ].
-
-
-
-
-
-
-!
-
-changeVariables
- | box names propList p n newName|
-
- names := VariableArray new.
- propList := VariableArray new.
- viewProperties do:[:props |
- n := props name.
- n notNil ifTrue:[
- names add:n.
- propList add:props
- ]
- ].
- box := BuilderVariablesBox new.
- box list:names.
- box selectAction:[:selection |
- p := propList at:selection
- ].
- box okAction:[
- newName := box enterValue.
-Transcript showCR:('renamed ' , (p name) , 'to:' , newName).
- p name:newName
- ].
- box showAtPointer
-
-
-
-! !
-
-!UIPainterView methodsFor:'creating subviews'!
-
-addProperties:properties for:aView
- "set properties to a view and add properties to viewProperties.
- In case that properties are nil properties are created
- "
- |name props|
-
- (props := properties) isNil ifTrue:[
- props := self propertiesForNewView:aView.
- ].
-
- viewProperties add:props.
- name := props name.
-
- (aView respondsTo:#label:) ifTrue:[
- aView label:name
- ].
- aView name:name.
- ^ props
-!
-
-initializeCreatedObject:anObject
- "set default properties for a created object
- "
- |props|
-
- props := self addProperties:nil for:anObject.
- self undoCreate:(props identifier).
-!
-
-propertiesForNewView:aView
- |cls props index|
-
- cls := aView class.
-
- props := ViewProperty new.
- props view:aView.
- props elementClass:cls.
- index := self variableIndexForClass:cls.
- props nameIndex:index.
- props name:(self variableNameForClass:cls index:index).
-
-"/ props initCode:nil. --- add user-defined init code later
-
- ^ props
-! !
-
-!UIPainterView methodsFor:'cut & paste'!
-
-copySelection
- "copy the selection into the cut&paste-buffer
- "
- |tmp|
-
- tmp := OrderedCollection new.
-
- self selectionDo:[:aView||topSpec|
- topSpec := aView specClass
- fromView:aView
- callBack:[:spec :aSubView |
- aSubView geometryLayout:(aSubView geometryLayout copy)
- ].
- tmp add:topSpec.
- ].
-
- self setSelection:tmp
-
-!
-
-pasteBuffer
- "add the objects in the paste-buffer
- "
-
- |sel|
-
- Transcript showCR:'pasteBuffer'.
- sel := self getSelection.
- self unselect.
- sel do:[:aSpec |
- self createFromSpec:aSpec
- ]
-! !
-
-!UIPainterView methodsFor:'draw-object initialization'!
-
-setupCreatedObject
- ^ self
-! !
-
-!UIPainterView methodsFor:'generating output'!
-
-generateClassDefinition
- |defCode|
-
- defCode := superclassName , ' subclass:#' , className , '\'.
- defCode := defCode , ' instanceVariableNames:'''.
- defCode := defCode , self subviewVariableNames , '''\'.
- defCode := defCode , ' classVariableNames:''''\'.
- defCode := defCode , ' poolDictionaries:''''\'.
- defCode := defCode , ' category:''' , categoryName , '''\'.
- defCode := defCode , Character excla asString , '\\'.
-
- code := code , (defCode withCRs)
-
-
-
-!
-
-generateCode
- code := ''.
- (Smalltalk classNamed:className) isNil ifTrue:[
- self generateClassDefinition.
- ].
-"/ self generateInitMethod.
- code := code , self generateWindowSpec.
- self generateOutlets.
-
-
- ^ code withCRs
-
- "Modified: 5.9.1995 / 20:57:53 / claus"
-! !
-
-!UIPainterView ignoredMethodsFor:'generating output'!
-
-generateInitCodeForGroup:aGroup
- |c name p objects outlets moreCode sym typ val|
-
- " <name> := <GroupClass> in:<name-of-superview>"
-
- 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
- |g c name p outlets moreCode sym typ val|
-
- "generate code for groups"
-
- viewProperties do:[:props |
- g := props at:#group ifAbsent:[nil].
- g notNil ifTrue:[
- self generateInitCodeForGroup:g
- ]
- ]
-
-
-!
-
-generateInitCodeForView:aView
- |c name p outlets moreCode sym typ val|
-
- " <name> := <ViewClass> in:<name-of-superview>"
-
- 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 |
- self generateInitCodeForView:v
- ]
-
- "Modified: 5.9.1995 / 20:06:07 / claus"
-!
-
-generateInitMethod
- |defCode|
-
- defCode := Character excla asString ,
- className , ' methodsFor:''initialization''' ,
- Character excla asString , '\\'.
-
- defCode := defCode , 'initialize\'.
- defCode := defCode , ' super initialize.\'.
- defCode := defCode , ' self setupSubViews.\'.
- defCode := defCode , ' self setupLocalStuff\'.
- defCode := defCode , Character excla asString , '\\'.
-
- defCode := defCode , 'setupSubViews\'.
- code := code , defCode withCRs.
-
- self subviewsOf:self do:[:v |
- self generateInitCodeForView:v
- ].
-
- self generateInitCodeForOtherStuff.
-
- code := code , ' ^ self\' withCRs.
-
- defCode := Character excla asString , '\\'.
- defCode := defCode , 'setupLocalStuff\'.
- defCode := defCode , ' ^ self\'.
- defCode := defCode , Character excla asString , ' ' ,
- Character excla asString , '\\'.
-
- code := code , defCode withCRs
-
-
-
-
-
-! !
-
-!UIPainterView methodsFor:'generating output'!
-
-generateOutlets
- ^ self
-!
-
-generateWindowSpec
- |spec specArray str|
-
- subViews remove:inputView.
- [
- spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec].
- ] valueNowOrOnUnwindDo:[
- subViews addFirst:inputView.
- ].
-
- specArray := spec literalArrayEncoding.
- str := WriteStream on:String new.
- self prettyPrintSpecArray:specArray on:str indent:5.
-
- code := Character excla asString
- , className , ' class methodsFor:''interface specs'''
- , Character excla asString , '\\'
-
- , methodName , '\'
- , ' "this window spec was automatically generated by the ST/X UIPainter"\\'
- , ' "do not manually edit this - the painter/builder may not be able to\'
- , ' handle the specification if its corrupted."\\'
- , ' "UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '"\'
- , ' "' , className , ' new openInterface:#' , methodName , '"\'.
-
- methodName = 'windowSpec' ifTrue:[
- code := code , ' "' , className , ' open"\'
- ].
- code := code
- , '\'
- , ' <resource: #canvas>\\'
- , ' ^\'
- , ' ', str contents
- , '\'
- , Character excla asString
- , ' '
- , Character excla asString
- , '\\'.
-
- ^ code withCRs
-
- "Modified: 5.9.1995 / 21:01:35 / claus"
-!
-
-nameOfClass
- ^ 'NewView'
-!
-
-outletValueOf:aSymbol for:aView
-"/ |c name p outlets moreCode sym typ val|
-"/
-"/ p := self propertyOfView:aView.
-"/ outlets := p at:#outlets ifAbsent:[^ nil].
-"/ outlets notNil ifTrue:[
-"/ outlets do:[:selectorOutlet |
-"/ sym := selectorOutlet at:#selector.
-"/ (sym == aSymbol) ifTrue:[
-"/ typ := selectorOutlet at:#type.
-"/ val := selectorOutlet at:#value.
-"/ ^ val
-"/ ]
-"/ ]
-"/ ].
- ^ nil
-
-
-
-
-!
-
-prettyPrintSpecArray:spec on:aStream indent:i
- "just for your convenience: prettyPrint a specArray to aStream - it looks better that way"
-
- |what oneLine|
-
- spec isArray ifFalse:[
- spec isLiteral ifTrue:[
- aStream nextPutAll:spec storeString
- ] ifFalse:[
- self halt.
- ].
- ^ self
- ].
-
- spec isEmpty ifTrue:[
- aStream nextPutAll:'#()'.
- ^ self
- ].
-
- what := spec at:1.
- what isArray ifTrue:[
- aStream cr; spaces:i+2.
- aStream nextPutAll:'#('.
- "/ a spec-collection
- spec do:[:element |
- self prettyPrintSpecArray:element on:aStream indent:i+2.
- ].
- aStream cr.
- aStream spaces:i+1.
- aStream nextPutAll:')'.
- ^ self.
- ].
-
- oneLine := false.
- (#(#LayoutFrame #LayoutOrigin #AlignmentOrigin
- #Rectangle #Point
- #Color #ColorValue
- )
- includesIdentical:what) ifTrue:[
- oneLine := true
- ].
-
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+2.
- ].
- aStream nextPutAll:'#('.
-
-
- aStream nextPutAll:what storeString.
-
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+4.
- ].
-
- 2 to:spec size do:[:index |
- aStream space.
- self prettyPrintSpecArray:(spec at:index) on:aStream indent:i+4.
- oneLine ifFalse:[
- (index odd and:[index ~~ (spec size)]) ifTrue:[
- aStream cr; spaces:i+4.
- ]
- ]
- ].
- oneLine ifFalse:[
- aStream cr.
- aStream spaces:i+1.
- ].
- aStream nextPutAll:')'.
-
- "Modified: 5.9.1995 / 17:44:20 / claus"
-!
-
-storeContentsOn:aStream
- viewProperties do:[:p| p storeOn:aStream]
-!
-
-stuffPropertiesFrom:view intoSpec:newSpec
- "stuff any additional information (held in the properties) into the spec
- which was just created from view"
-
- |props aspectSelector changeSelector labelSelector name|
-
- props := self propertyOfView:view.
- props isNil ifTrue:[^ self].
-
- (aspectSelector := props aspectSelector) notNil ifTrue:[
- newSpec model:aspectSelector
- ].
- (changeSelector := props changeSelector) notNil ifTrue:[
- newSpec change:changeSelector
- ].
- (labelSelector := props labelSelector) notNil ifTrue:[
- newSpec label:labelSelector
- ].
- (name := props name) notNil ifTrue:[
- newSpec name:name
- ].
-
-!
-
-subviewVariableNames
- |names|
-
- names := ''.
- viewProperties do:[:p| names := names , ' ' , (p name)].
- ^ names
-!
-
-subviewsOf:aView do:aBlock
- |subs v|
-
- (subs := aView subViews) notNil ifTrue:[
- subs do:[:v|
- (v ~~ inputView and:[v notNil]) ifTrue:[
- (viewProperties detect:[:p | p view == v] ifNone:nil) notNil ifTrue:[
- (v superView == aView) ifTrue:[
- aBlock value:v
- ]
- ]
- ]
- ]
- ]
-
-! !
-
-!UIPainterView methodsFor:'group manipulations'!
-
-groupEnterFields
- |props name index group objects|
-
- selection isNil ifTrue:[^ self].
- self selectionDo:[:aView |
- (aView isKindOf:EditField) ifFalse:[
- self warn:'select EditFields only !!'.
- ^ self
- ]
- ].
- self selectionHiddenDo:[
- group := EnterFieldGroup new.
-
- props := GroupProperties new.
- props elementClass:EnterFieldGroup.
- props group:group.
- index := self variableIndexForClass:EnterFieldGroup.
- props nameIndex:index.
- name := self variableNameForClass:EnterFieldGroup index:index.
- props name:name.
- objects := OrderedCollection new.
- props controlledObjects:objects.
- viewProperties add:props.
-
- self selectionDo:[:aView |
- objects add:aView.
- group add:aView
- ].
- ]
-
-
-!
-
-groupRadioButtons
- |props name index group objects|
-
- selection isNil ifTrue:[^ self].
- self selectionDo:[:aView |
- (aView isKindOf:RadioButton) ifFalse:[
- self warn:'select RadioButtons only !!'.
- ^ self
- ]
- ].
- self selectionHiddenDo:[
-
- group := RadioButtonGroup new.
-
- props := GroupProperties new.
- props elementClass:RadioButtonGroup.
- props group:group.
- index := self variableIndexForClass:RadioButtonGroup.
- props nameIndex:index.
- name := self variableNameForClass:RadioButtonGroup index:index.
- props name:name.
- group groupID:name asSymbol.
- objects := OrderedCollection new.
- props controlledObjects:objects.
- viewProperties add:props.
-
- self selectionDo:[:aView |
- aView turnOff.
- objects add:aView.
- group add:aView
- ].
- ]
-
- "Modified: 5.9.1995 / 16:06:15 / claus"
-! !
-
-!UIPainterView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- superclassName := 'ApplicationModel'.
- className := 'NewApplication'.
- methodName := 'windowSpec'.
- categoryName := 'Applications'.
-
- pressAction := [:pressPoint | self startSelectOrMove:pressPoint].
- shiftPressAction := [:pressPoint | self startSelectMoreOrMove:pressPoint].
- motionAction := [:movePoint | true].
- releaseAction := [true].
- keyPressAction := [:key | self doKeyInput:key].
-
- viewProperties := OrderedCollection new.
-
- HandCursor := Cursor leftHand.
-
- "Modified: 5.9.1995 / 19:58:06 / claus"
-!
-
-initializeMiddleButtonMenu
- |labels|
-
- labels := resources array:#(
- 'copy'
- 'cut'
- 'paste'
- '-'
- 'save'
- 'print'
- '-'
- 'inspect'
- ).
-
- self middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
- copySelection
- deleteSelection
- pasteBuffer
- nil
- save
- print
- nil
- inspectSelection
- )
- receiver:self
- for:self)
-
-! !
-
-!UIPainterView methodsFor:'interface to Builder'!
-
-addOutletDefinitionFor:outletSymbol type:type value:outletValue for:aView
- |outletProps selectorProps viewProps|
-
- viewProps := self propertyOfView:aView.
-"/ outletProps := viewProps at:#outlets ifAbsent:[nil].
-"/ outletProps isNil ifTrue:[
-"/ outletProps := Dictionary new.
-"/ viewProps at:#outlets put:outletProps
-"/ ].
-"/ selectorProps := outletProps at:outletSymbol ifAbsent:[nil].
-"/ selectorProps isNil ifTrue:[
-"/ selectorProps := Dictionary new.
-"/ outletProps at:outletSymbol put:selectorProps
-"/ ].
-"/
-"/ selectorProps at:#selector put:outletSymbol.
-"/ selectorProps at:#type put:type.
-"/ selectorProps at:#value put:outletValue
-
-!
-
-addSpec:specOrSpecArray
- |spec builder|
-
- spec := UISpecification from:specOrSpecArray.
-
- builder := UIBuilder new.
- builder componentCreationHook:[:view :spec :aBuilder |
- self createdComponent:view forSpec:spec
- ].
- builder applicationClass:(Smalltalk classNamed:className).
- spec setupView:self for:builder.
- self realizeAllSubViews.
- inputView raise.
-
-"/ viewProperties := OrderedCollection new.
-"/ self generatePropertiesFor:(self subViews select:[:v | v ~~ inputView]).
-
- self changed:#tree.
-
-
- "Modified: 5.9.1995 / 23:36:55 / claus"
-!
-
-applicationName
- ^ className
-!
-
-aspectSelectorForView:aView
- |props aspect|
-
- props := self propertyOfView:aView.
- props isNil ifTrue:[^ nil].
- ^ props aspectSelector
-
-!
-
-changeSelectorForView:aView
- |props aspect|
-
- props := self propertyOfView:aView.
- props isNil ifTrue:[^ nil].
-"/ ^ props changeSelector
- ^ nil
-!
-
-createFromSpec:specOrSpecArray
- |spec builder v|
-
- spec := UISpecification from:specOrSpecArray.
-
- builder := UIBuilder new.
- builder componentCreationHook:[:view :spec :aBuilder |
- self createdComponent:view forSpec:spec
- ].
- builder applicationClass:(Smalltalk classNamed:className).
- v := spec buildViewWithLayoutFor:builder in:self.
- self realizeAllSubViews.
- inputView raise.
-
- self changed:#tree.
-
-
- "Modified: 5.9.1995 / 23:36:55 / claus"
-!
-
-generatePropertiesFor:aCollectionOfViews
-
- "/ done as two loops, to get bread-first naming
-
- aCollectionOfViews do:[:aView|
- |props|
-
- props := self propertiesForNewView:aView.
- viewProperties add:props.
- aView name:(props name).
-
- aView geometryLayout isNil ifTrue:[
- aView geometryLayout:(aView bounds asLayout).
- ]
- ].
-
- aCollectionOfViews do:[:aView |
- |subs|
-
- subs := aView subViews.
- subs notNil ifTrue:[
- self generatePropertiesFor:subs
- ]
- ].
-
-!
-
-inspectAttributes
- |p|
-
- self singleSelectionDo:[:aView |
- p := self propertyOfView:aView.
- p inspect
- ]
-!
-
-setAspectSelector:aspectSymbol forView:aView
- |props|
-
- props := self propertyOfView:aView.
-
- undoHistory transactionNamed:'aspect' do:[
- self selectionDo:[:aView|
- undoHistory isTransactionOpen ifTrue:[
- |oldAspect|
-
- oldAspect := props aspectSelector.
- undoHistory addUndoBlock:[
- props aspectSelector:oldAspect.
- self elementChanged:aView.
- ]
- ].
- ].
- ].
-
- props aspectSelector:aspectSymbol
-
-!
-
-setChangeSelector:changeSymbol forView:aView
- |props|
-
- props := self propertyOfView:aView.
- props changeSelector:changeSymbol
-
-!
-
-setupFromSpec:specOrSpecArray
- self removeAll.
- self addSpec:specOrSpecArray
-!
-
-showFontPanel
- |action|
-
- fontPanel isNil ifTrue:[
- fontPanel := FontPanel new
- ].
-
- selection notNil ifTrue:[
- action := [:family :face :style :size |
- self changeFontFamily:family face:face
- style:style size:size
- ].
- fontPanel action:action.
- fontPanel showAtPointer
- ]
-! !
-
-!UIPainterView methodsFor:'misc'!
-
-changeFontFamily:family face:face style:style size:size
- |f|
-
- f := Font family:family
- face:face
- style:style
- size:size.
-
- f notNil ifTrue:[
- self selectionHiddenDo:[
- self selectionDo:[:aView |
- aView font:f.
- self elementChanged:aView.
- ]
- ]
- ]
-
- "Modified: 5.9.1995 / 12:13:27 / claus"
-!
-
-changeVariableNameOf:aView to:newName
- |prop|
-
- prop := self propertyOf:aView.
-
- prop isNil ifTrue:[
- ^ self error:'no such view'
- ].
-
- ((aView respondsTo:#label:) and:[aView label = prop name]) ifTrue:[
- self selectionHiddenDo:[
- |layout|
- layout := aView geometryLayout copy.
- aView label:newName.
- aView geometryLayout:layout.
- ]
- ].
-
- prop name:newName.
- aView name:newName.
- self changed:#widgetName
-
-
-
-!
-
-propertyOf:something
-
- ^ viewProperties detect:[:p| (p view == something or:[p group == something])]
- ifNone:nil
-
-
-
-
-
-!
-
-propertyOfGroup:aGroup
-
- ^ viewProperties detect:[:p| p group == aGroup] ifNone:nil
-!
-
-propertyOfName:aString
-
- aString = 'self' ifFalse:[
- ^ viewProperties detect:[:p| p name = aString] ifNone:nil
- ].
- ^ nil
-!
-
-propertyOfView:aView
-
- aView == self ifFalse:[
- ^ viewProperties detect:[:p| p view == aView] ifNone:nil
- ].
- ^ nil
-!
-
-removePropertyOf:aView
- |p|
-
- p := self propertyOf:aView.
- p notNil ifTrue:[viewProperties remove:p]
-
-
-!
-
-variableIndexForClass:aClass
- |max|
-
- max := 0.
-
- viewProperties do:[:p|
- p elementClass == aClass ifTrue:[
- max := max max:(p nameIndex)
- ]
- ].
- ^ max + 1
-
-!
-
-variableNameForClass:aClass index:index
- |n|
-
- n := (aClass name) , index printString.
- n at:1 put:(n at:1) asLowercase.
- ^ n
-
-!
-
-variableNameOf:aView
- |prop|
-
- aView notNil ifTrue:[
- prop := self propertyOf:aView
- ].
-
- prop notNil ifTrue:[^ prop name]
- ifFalse:[^ 'self']
-
-! !
-
-!UIPainterView methodsFor:'private undo-actions'!
-
-undoCreate:aViewIdentifier
-
- undoHistory isTransactionOpen ifTrue:[
- undoHistory addUndoBlock:[
- |p|
-
- p := viewProperties detect:[:p| p identifier == aViewIdentifier]
- ifNone:nil.
-
- p notNil ifTrue:[
- self removeObject:(p view)
- ]
- ]
- ]
-!
-
-undoRemove:propertyOfView
- |clsName layout parent aView|
-
- undoHistory isTransactionOpen ifFalse:[
- ^ self
- ].
-
- aView := propertyOfView view.
- clsName := aView class.
- layout := aView geometryLayout.
- parent := aView superView.
-
- parent ~~ self ifTrue:[
- parent := (self propertyOf:parent) identifier.
- ] ifFalse:[
- parent := nil
- ].
-
- propertyOfView view:nil.
-
- undoHistory addUndoBlock:[
- |recreatedView props|
-
- parent notNil ifTrue:[
- props := viewProperties detect:[:p| p identifier == parent] ifNone:nil.
-
- props notNil ifTrue:[parent := props view]
- ifFalse:[parent := self]
- ] ifFalse:[
- parent := self
- ].
-
- recreatedView := clsName in:parent.
- recreatedView geometryLayout:layout.
- propertyOfView view:recreatedView.
- self addProperties:propertyOfView for:recreatedView.
- recreatedView realize.
- inputView raise.
- self changed:#tree.
- ].
- aView := nil.
-
-! !
-
-!UIPainterView methodsFor:'removing components'!
-
-remove:something
- "remove something, anObject or a collection of objects from the contents
- do redraw"
-
- self forEach:something do:[:anObject |
- self removeObject:anObject
- ]
-
-
-!
-
-removeAll
- "remove the argument, anObject"
-
- self unselect.
-
- subViews notNil ifTrue:[
- subViews copy do:[:sub |
- sub ~~ inputView ifTrue:[
- self removeTreeFrom:sub
- ]
- ]
- ].
-
- viewProperties := OrderedCollection new.
- undoHistory reinitialize.
-
- self changed:#tree
-
- "Modified: 5.9.1995 / 23:39:08 / claus"
-!
-
-removeObject:anObject
- "remove the argument, anObject"
-
- self removeTreeFrom:anObject.
- self changed:#tree
-
- "Modified: 5.9.1995 / 20:51:28 / claus"
-!
-
-removeTreeFrom:anObject
- "remove the argument, anObject and all of its children
- "
- anObject isNil ifTrue:[
- ^ self
- ].
-
- (anObject subViews notNil) ifTrue:[
- anObject subViews copy do:[:sub |
- self removeTreeFrom:sub
- ]
- ].
-
- self undoRemove:(self propertyOf:anObject).
- self removePropertyOf:anObject.
- anObject destroy
-! !
-
-!UIPainterView methodsFor:'selections'!
-
-addNameToSelection:aString
- |prop|
-
- prop := self propertyOfName:aString.
-
- prop notNil ifTrue:[
- self addToSelection:(prop view)
- ]
-
-!
-
-removeNameFromSelection:aString
- |prop|
-
- prop := self propertyOfName:aString.
-
- prop notNil ifTrue:[
- self removeFromSelection:(prop view)
- ]
-
-!
-
-selectName:aString
- |prop|
-
- prop := self propertyOfName:aString.
-
- prop notNil ifTrue:[
- self select:(prop view)
- ] ifFalse:[
- self unselect
- ]
-! !
-
-!UIPainterView methodsFor:'testing'!
-
-isHorizontalResizable:aComponent
-
- (aComponent isKindOf:ScrollBar) ifTrue:[
- ^ aComponent orientation == #horizontal
- ].
- (aComponent isKindOf:Scroller) ifTrue:[
- ^ aComponent orientation == #horizontal
- ].
- (aComponent isKindOf:Slider) ifTrue:[
- ^ aComponent orientation == #horizontal
- ].
- ^ true
-
-
-!
-
-isVerticalResizable:aComponent
-
- (aComponent isKindOf:EditField) ifTrue:[
- ^ false
- ].
- (aComponent isKindOf:ScrollBar) ifTrue:[
- ^ aComponent orientation == #vertical
- ].
- (aComponent isKindOf:Scroller) ifTrue:[
- ^ aComponent orientation == #vertical
- ].
- (aComponent isKindOf:Slider) ifTrue:[
- ^ aComponent orientation == #vertical
- ].
- ^ true
-
-
-! !
-
-!UIPainterView::ViewProperty class methodsFor:'instance creation'!
-
-new
- Identifier notNil ifTrue:[Identifier := Identifier + 1]
- ifFalse:[Identifier := 1].
-
- ^ self basicNew initialize
-! !
-
-!UIPainterView::ViewProperty methodsFor:'accessing'!
-
-aspectSelector
- "return the value of the instance variable 'aspectSelector' (automatically generated)"
-
- ^ aspectSelector
-!
-
-aspectSelector:something
- "set the value of the instance variable 'aspectSelector' (automatically generated)"
-
- aspectSelector := something.
-!
-
-changeSelector
- "return the value of the instance variable 'changeSelector' (automatically generated)"
-
- ^ changeSelector!
-
-changeSelector:something
- "set the value of the instance variable 'changeSelector' (automatically generated)"
-
- changeSelector := something.!
-
-elementClass
- "return the value of the instance variable 'elementClass' (automatically generated)"
-
- ^ elementClass!
-
-elementClass:something
- "set the value of the instance variable 'elementClass' (automatically generated)"
-
- elementClass := something.!
-
-group
- ^ nil
-!
-
-identifier
- "return the unique identifier assigned to property
- "
- ^ identifier
-!
-
-labelSelector
- "return the value of the instance variable 'labelSelector' (automatically generated)"
-
- ^ labelSelector!
-
-labelSelector:something
- "set the value of the instance variable 'labelSelector' (automatically generated)"
-
- labelSelector := something.!
-
-name
- "return the value of the instance variable 'name' (automatically generated)"
-
- ^ name!
-
-name:something
- "set the value of the instance variable 'name' (automatically generated)"
-
- name := something.!
-
-nameIndex
- "return the value of the instance variable 'nameIndex' (automatically generated)"
-
- ^ nameIndex!
-
-nameIndex:something
- "set the value of the instance variable 'nameIndex' (automatically generated)"
-
- nameIndex := something.!
-
-view
- "return the value of the instance variable 'view' (automatically generated)"
-
- ^ view!
-
-view:something
- "set the value of the instance variable 'view' (automatically generated)"
-
- view := something.! !
-
-!UIPainterView::ViewProperty methodsFor:'initialization'!
-
-initialize
- super initialize.
- identifier := Identifier
-! !
-
!UIPainterView::GroupProperties methodsFor:'accessing'!
controlledObjects
@@ -1390,8 +27,3 @@
group := something.! !
-!UIPainterView class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-! !