so far ...
--- a/UIObjectView.st Fri Feb 21 20:33:57 1997 +0100
+++ b/UIObjectView.st Tue Feb 25 14:15:56 1997 +0100
@@ -1,18 +1,3 @@
-ObjectView subclass:#UIObjectView
- instanceVariableNames:'inputView testMode undoHistory copiedExtent actionData
- createClass clipChildren'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-UIPainter'
-!
-
-Object subclass:#UndoHistory
- instanceVariableNames:'history transaction enabled'
- classVariableNames:''
- poolDictionaries:''
- privateIn:UIObjectView
-!
-
Object subclass:#Transaction
instanceVariableNames:'type text actions'
classVariableNames:''
@@ -20,1966 +5,6 @@
privateIn:UIObjectView::UndoHistory
!
-
-!UIObjectView class methodsFor:'defaults'!
-
-defaultGrid
- ^ 4 @ 4
-
-!
-
-gridShown
- ^ false
-
-!
-
-handleSize
- "size of blob drawn for handles"
- ^ 4
-
-!
-
-hitDelta
- ^ 4
-
-! !
-
-!UIObjectView methodsFor:'accessing'!
-
-gridParameters
- "used by defineGrid, and in a separate method for
- easier redefinition in subclasses.
- Returns the grid parameters in an array of 7 elements,
- which control the appearance of the grid-pattern.
- the elements are:
-
- bigStepH number of pixels horizontally between 2 major steps
- bigStepV number of pixels vertically between 2 major steps
- littleStepH number of pixels horizontally between 2 minor steps
- littleStepV number of pixels vertically between 2 minor steps
- gridAlignH number of pixels for horizontal grid align (pointer snap)
- gridAlignV number of pixels for vertical grid align (pointer snap)
- docBounds true, if document boundary should be shown
-
- if littleStepH/V are nil, only bigSteps are drawn.
- "
-
- ^ #(10 10 nil nil 10 10 false)
-
-
-!
-
-hideGrid
- gridShown ifTrue:[
- self withSelectionHiddenDo:[
- super hideGrid
- ]
- ]
-
-
-!
-
-showGrid
- self withSelectionHiddenDo:[
- super showGrid
- ]
-
- "Modified: 5.9.1995 / 12:47:46 / claus"
-
-
-!
-
-testMode
- "returns testMode
- "
- ^ testMode
-
-
-!
-
-testMode:aBoolean
- "change testMode
- "
- (aBoolean == testMode) ifFalse:[
- testMode := aBoolean.
-
- testMode ifTrue:[
- self unselect.
- inputView unrealize
- ] ifFalse:[
- inputView raise.
- inputView realize
- ]
- ]
-
-
-! !
-
-!UIObjectView methodsFor:'blocked'!
-
-addObject:anObject
- "add the argument, anObject to the contents - with redraw"
-
- self halt
-
-!
-
-addObjectWithoutRedraw:anObject
- "add the argument, anObject to the contents - with redraw"
-
- self halt
-
-! !
-
-!UIObjectView methodsFor:'event handling'!
-
-elementChanged:aView
- "some element has been changed - kludge to force a resizing
- operation (for child layout recomputation) in its superView"
-
- aView superView sizeChanged:nil.
- self changed:#any.
-
-
-!
-
-elementChangedLayout:aView
- "some element has been changed - kludge to force a resizing
- operation (for child layout recomputation) in its superView"
-
- aView superView sizeChanged:nil.
- self changed:#layout.
-
-
-!
-
-exposeX:x y:y width:w height:h
- "handle an expose event from device; redraw selection
- "
- super exposeX:x y:y width:w height:h.
- self selectionDo:[:v | self showSelected:v]
-
-
-!
-
-keyPress:key x:x y:y
- <resource: #keyboard ( #InspectIt #Delete #BackSpace #Cut) >
-
- key == #InspectIt ifTrue:[
- ^ self inspectSelection
- ].
-
- (key == #Cut or:[key == #Delete or:[key == #BackSpace]]) ifTrue: [
- ^ self deleteSelection
- ].
-
- super keyPress:key x:x y:y
-
-
-!
-
-processEvent:anEvent
- "catch expose events for components, and redraw its handles after
- the redraw when this happens
- "
- |view|
-
- selection notNil ifTrue:[
- anEvent type == #damage ifTrue:[
- view := anEvent view.
- (selection == view
- or:[selection isCollection
- and:[selection includes:view]]) ifTrue:[
- self showSelected:view
- ]
- ]
- ].
- ^ false.
-
-
-!
-
-sizeChanged:how
- self withSelectionHiddenDo:[
- super sizeChanged:how
- ]
-
-
-! !
-
-!UIObjectView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- "funny: since I do not want the created widgets to get pointer
- events, I put an InputView on top of them, which catches those events
- and passes them back to me - have to take care, that this inputView
- is always on top
- "
- inputView := InputView origin:0.0@0.0 extent:1.0@1.0 in:self.
-
- inputView eventReceiver:self.
- inputView enableButtonEvents.
- inputView enableButtonMotionEvents.
-
- self setDefaultActions.
-
- undoHistory := UndoHistory new.
- testMode := false.
- clipChildren := true.
-
- (self class gridShown) ifTrue:[
- super showGrid
- ].
-
-!
-
-realize
- super realize.
- self windowGroup postEventHook:self
-
-! !
-
-!UIObjectView methodsFor:'misc'!
-
-cursor:aCursor
- inputView realized ifTrue:[
- inputView cursor:aCursor
- ].
- super cursor:aCursor
-
-
-!
-
-invertOutlineOf:anObject
- |wasClipped delta|
-
- (wasClipped := clipChildren) ifTrue:[
- self clippedByChildren:(clipChildren := false).
- ].
- delta := (anObject originRelativeTo:self) - anObject origin.
-
- self xoring:[
- self displayRectangle:((anObject origin + delta) extent:anObject extent).
- ].
-
- 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 := nil.
-
- self cursor:Cursor normal.
-
-!
-
-showDragging:something offset:anOffset
- "drag around a View"
-
- |top|
-
- self forEach:something do:[:anObject |
- self drawRectangle:((anObject origin + anOffset) extent:(anObject extent))
- ]
-
-! !
-
-!UIObjectView methodsFor:'object creation'!
-
-actionCreate:anObject frame:aFrame delta:aDelta
- "create and initialize action data
- "
- |extent x y selectors values|
-
-"minimum extent
-"
- extent := self extent.
- x := extent x // 3.
- y := extent y // 3.
- extent := anObject preferredExtent.
-
- (extent x > x) ifTrue:[extent x:x].
- (extent y > y) ifTrue:[extent y:y].
-
-"setup structure
-"
- selectors := #( object frame delta vertical horizontal minExtent ).
- values := Array new:(selectors size).
-
- values at:1 put:anObject.
- values at:2 put:aFrame.
- values at:3 put:aDelta.
- values at:4 put:(self isVerticalResizable:anObject).
- values at:5 put:(self isHorizontalResizable:anObject).
- values at:6 put:extent.
-
- actionData := Structure newWith:selectors values:values.
-
-
-"can change cursor dependent on vertical/horizontal resizing
-"
- oldCursor := cursor.
- self cursor:(Cursor leftHand).
-
-
-
-!
-
-createWidgetWithClass:aClass
- "prepare to create new widgets
- "
- createClass := aClass.
- pressAction := [:pressPoint | self startCreate:pressPoint].
- self cursor:Cursor origin.
-
-
-!
-
-doDragCreate:aPoint
- "do a widget create drag
- "
- |frame object extent minimum|
-
- frame := actionData frame.
- frame corner:((self alignToGrid:aPoint) - (actionData delta)).
-
- object := actionData object.
- minimum := actionData minExtent.
- extent := frame extent.
-
- ((extent x < minimum x) or:[actionData horizontal not]) ifTrue:[
- extent x:(minimum x)
- ].
-
- ((extent y < minimum y) or:[actionData vertical not]) ifTrue:[
- extent y:(minimum y)
- ].
-
- frame extent:extent.
-
- self invertOutlineOf:object.
- object origin:(frame origin) extent:(frame extent).
- self invertOutlineOf:object.
-!
-
-endCreate
- "end a widget create drag
- "
- |layout x y|
-
- self invertOutlineOf:(actionData object).
- inputView raise.
-
- layout := (actionData object) bounds asLayout.
- (actionData object) geometryLayout:layout.
-
- self changed:#tree.
- self select:(actionData object).
- actionData := nil.
-
- self setDefaultActions.
-
-!
-
-setupCreatedObject:anObject
- self subclassResponsibility
-!
-
-startCreate:aPoint
- "start a widget create
- "
- |widget object start frame delta|
-
- (createClass isNil or:[self numberOfSelections > 1]) ifTrue:[
- self unselect.
- ^ self setDefaultActions.
- ].
-
- motionAction := [:movePoint| self doDragCreate:movePoint].
- releaseAction := [ self endCreate].
-
- widget := self singleSelection.
-
- ( widget notNil
- and:[(self isPoint:aPoint containedIn:widget)
- and:[self supportsSubComponents:widget]]
- ) ifFalse:[
- self unselect.
- widget := self.
- ].
-
- object := createClass new.
- widget addSubView:object.
-
- start := self alignToGrid:aPoint.
- delta := widget originRelativeTo:self.
- frame := Rectangle origin:(start - delta) corner:start.
-
- object origin:(frame origin).
- self setupCreatedObject:object.
- object realize.
-
- self actionCreate:object frame:frame delta:delta.
- self invertOutlineOf:object.
-
-
-! !
-
-!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.
- ].
-!
-
-moveObject:anObject to:aPoint
- "move anObject to newOrigin, aPoint
- "
- |dX dY org delta|
-
- anObject notNil ifTrue:[
- org := anObject computeOrigin.
-
- delta := aPoint - org.
- delta := (self alignToGrid:aPoint) - org.
- dX := delta x.
- dY := delta y.
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:anObject top:dY bottom:dY left:dX right:dX
- ]
- ]
-
-!
-
-startObjectMoveAt:aPoint
-
- self startObjectMove:selection at:aPoint.
-
- selection isCollection ifTrue:[
- movedObject := selection
- ] ifFalse:[
- movedObject := Array with:selection
- ].
- super unselect.
-
- moveDelta := movedObject collect:[:aView|
- aPoint - aView computeOrigin
- ].
-
- self transaction:#move objects: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 object selected and point hits a handle, start a resize
- "
- anObject := self singleSelection.
-
- anObject notNil ifTrue:[
- b := self whichHandleOf:anObject isHitBy:aPoint.
-
- (b notNil and:[b ~~ #view]) ifTrue:[
- ^ self startResizeBorder:b of:anObject.
- ]
- ].
-
- anObject := self findObjectAt:aPoint.
-
- "nothing is selected
- "
- anObject isNil ifTrue:[
- ^ self unselect
- ].
-
- (self isSelected:anObject) ifFalse:[
- super unselect.
- self select:anObject.
- ].
-
- (self numberOfSelections ~~ 1) ifTrue:[
- releaseAction := [
- self setDefaultActions.
- self select:anObject
- ]
- ] ifFalse:[
- releaseAction := [self setDefaultActions]
- ].
-
- "prepare move operation for an object
- "
- motionAction := [:movePoint|
- (aPoint dist:movePoint) > 4.0 ifTrue:[
- self startObjectMoveAt:aPoint
- ]
- ].
-! !
-
-!UIObjectView methodsFor:'object resize'!
-
-actionResize:anObject selector:aSelector
- "create and initialize action for resize
- "
- |selector delta|
-
- delta := anObject container originRelativeTo:self.
- selector := ('resize:', aSelector, ':') asSymbol.
-
- actionData := Structure with:(#object->anObject)
- with:(#selector->selector)
- with:(#delta->delta).
-
-"can change cursor dependent on vertical/horizontal resizing
-"
- oldCursor := cursor.
- self cursor:(Cursor leftHand).
-
-
-
-!
-
-doDragResize:aPoint
- "do a widget resize drag"
-
- |p object|
-
- object := actionData object.
-
- self invertOutlineOf:object.
- p := (self alignToGrid:aPoint) - (actionData delta).
- self perform:(actionData selector) with:object with:p.
- object geometryLayout:(object geometryLayout).
- self invertOutlineOf:object
-
-!
-
-endResize
- "cleanup after object resize"
-
- self invertOutlineOf:(actionData object).
- self setDefaultActions.
- self select:(actionData object).
- actionData := nil
-
- "Modified: 5.9.1995 / 17:11:17 / claus"
-
-!
-
-startResizeBorder:b of:selection
- "resize selected view
- "
- |object|
-
- object := self singleSelection.
-
- (object geometryLayout) isNil ifTrue:[
- ^ self setDefaultActions.
- ].
-
- self actionResize:object selector:b.
-
- self transaction:#extent selectionDo:[:aView|
- self undoBlockDimensionChanged:aView
- ].
- super unselect.
-
- motionAction := [:movePoint | self doDragResize:movePoint].
- releaseAction := [self endResize].
- self invertOutlineOf:object
-! !
-
-!UIObjectView methodsFor:'private handles'!
-
-handlesOf:aComponent do:aBlock
- |delta layout vertical horizontal|
-
- layout := aComponent geometryLayout.
- delta := (aComponent originRelativeTo:self) - aComponent origin.
-
- (layout isLayout not or:[layout isLayoutFrame]) ifTrue:[
- vertical := self isVerticalResizable:aComponent.
- horizontal := self isHorizontalResizable:aComponent.
- ] ifFalse:[
- vertical := false.
- horizontal := false.
- ].
-
- horizontal ifTrue:[
- aBlock value:(aComponent leftCenter + delta) value:#left.
- aBlock value:(aComponent rightCenter + delta) value:#right.
- ].
-
- vertical ifTrue:[
- aBlock value:(aComponent topCenter + delta) value:#top.
- aBlock value:(aComponent bottomCenter + delta) value:#bottom.
- ].
-
- (horizontal and:[vertical]) ifTrue:[
- aBlock value:(aComponent origin + delta) value:#origin.
- aBlock value:(aComponent corner + delta) value:#corner.
- aBlock value:(aComponent topRight + delta) value:#topRight.
- aBlock value:(aComponent bottomLeft + delta) value:#bottomLeft.
- ] ifFalse:[
- aBlock value:(aComponent origin + delta) value:#view.
- aBlock value:(aComponent corner + delta) value:#view.
- aBlock value:(aComponent topRight + delta) value:#view.
- aBlock value:(aComponent bottomLeft + delta) value:#view.
- ].
-
-!
-
-showSelected:aComponent
- |wasClipped delta oldPaint|
-
- self paint:Color black.
-
- (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)]
- ].
-
- wasClipped ifTrue:[
- self clippedByChildren:(clipChildren := true).
- ].
- self paint:oldPaint.
-!
-
-showUnselected:aComponent
- |wasClipped delta r oldPaint|
-
- r := aComponent origin extent:8@8.
-
- (wasClipped := clipChildren) ifTrue:[
- self clippedByChildren:(clipChildren := false).
- ].
-
- self handlesOf:aComponent do:[:pnt :what |
- self clearRectangle:(pnt - (4@4) extent:7@7).
- ].
-
- wasClipped ifTrue:[
- self clippedByChildren:(clipChildren := true).
- ].
-
- "/ must redraw all components which are affected b the handles
-
- r := (aComponent originRelativeTo:self) - (4@4)
- extent:(aComponent extent + (4@4)).
-
- subViews do:[:anotherComponent |
- |absOrg absFrame|
-
- anotherComponent ~~ inputView ifTrue:[
- absOrg := anotherComponent originRelativeTo:self.
- absFrame := absOrg extent:(anotherComponent extent).
- (absFrame intersects:r) ifTrue:[
- anotherComponent withAllSubViewsDo:[:v |
- v clear.
- v exposeX:0 y:0 width:9999 height:9999.
- ]
- ]
- ]
- ]
-
-!
-
-whichHandleOf:aView isHitBy:aPoint
- |bounds|
-
- self handlesOf:aView do:[:pnt :what |
- ((pnt - (4@4) extent:7@7) containsPoint:aPoint) ifTrue:[
- ^ what
- ].
- ].
-
- ^ nil
-
- "Modified: 5.9.1995 / 14:39:34 / claus"
-
-! !
-
-!UIObjectView methodsFor:'private resizing-subviews'!
-
-resize:aView bottom:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:0 bottom:((aPoint y) - (aView computeCorner y))
- ]
-!
-
-resize:aView bottomLeft:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:0
- bottom:((aPoint y) - (aView computeCorner y))
- left:((aPoint x) - (aView computeOrigin x))
- right:0
-
- ]
-
-
-!
-
-resize:aView corner:aPoint
- |delta|
-
- delta := aPoint - aView computeCorner.
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:0 bottom:(delta y) left:0 right:(delta x)
- ]
-!
-
-resize:aView left:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView left:((aPoint x) - (aView computeOrigin x)) right:0
- ]
-
-!
-
-resize:aView origin:aPoint
- |delta|
-
- delta := aPoint - aView computeOrigin.
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:(delta y) bottom:0 left:(delta x) right:0
- ]
-
-!
-
-resize:aView right:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView left:0 right:((aPoint x) - (aView computeCorner x))
- ]
-!
-
-resize:aView top:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:((aPoint y) - (aView computeOrigin y)) bottom:0
- ]
-!
-
-resize:aView topRight:aPoint
-
- undoHistory disabledTransitionDo:[
- self shiftLayout:aView top:((aPoint y) - (aView computeOrigin y))
- bottom:0
- left:0
- right:((aPoint x) - (aView computeCorner x))
-
- ]
-
-! !
-
-!UIObjectView methodsFor:'private shift-layout'!
-
-shiftLayout:aView left:l right:r
- "shift layout for a view; in case of an open transaction, the undo
- action is registered
- "
- self shiftLayout:aView top:0 bottom:0 left:l right:r
-
-!
-
-shiftLayout:aView top:t bottom:b
- "shift layout for a view; in case of an open transaction, the undo
- action is registered
- "
- self shiftLayout:aView top:t bottom:b left:0 right:0
-
-
-!
-
-shiftLayout:aView top:t bottom:b left:l right:r
- "shift layout for a view; in case of an open transaction, the undo
- action is registered
- "
- |layout|
-
- layout := aView geometryLayout.
-
- layout isLayout ifTrue:[
- self undoBlockPositionChanged:aView.
-
- layout leftOffset:(layout leftOffset + l)
- topOffset:(layout topOffset + t).
-
- layout isLayoutFrame ifTrue:[
- layout bottomOffset:(layout bottomOffset + b).
- layout rightOffset:(layout rightOffset + r).
- ].
- aView geometryLayout:layout.
- ] ifFalse:[
- |pixelOrigin|
-
- self undoBlockPositionChanged:aView.
-
- pixelOrigin := aView pixelOrigin.
- pixelOrigin := pixelOrigin + (l@t).
- aView pixelOrigin:pixelOrigin
- ]
-
-
-! !
-
-!UIObjectView methodsFor:'searching'!
-
-findObjectAt:aPoint
- "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.
-
- [viewId notNil] whileTrue:[
- lastId := viewId.
- viewId := device viewIdFromPoint:point in:lastId
- ].
-
- inputView raise.
-
- view := device viewFromId:lastId.
-
- view ~~ inputView ifTrue:[^ view]
- ifFalse:[^ nil]
-
-
-!
-
-isPoint:aPoint containedIn:aView
- "checks whether a point is covered by a view.
- "
- |p|
-
- p := device translatePoint:aPoint from:inputView id to:aView id.
-
- (p x >= 0 and:[p y >= 0]) ifTrue:[
- p := aView extent - p.
-
- (p x >= 0 and:[p y >= 0]) ifTrue:[
- ^ true
- ]
- ].
- ^ false
-!
-
-whichBorderOf:aView isHitBy:aPoint
- |p r bw org|
-
- bw := aView borderWidth.
- p := aPoint - (aView superView originRelativeTo:self).
-
- r := Rectangle origin:(aView origin)
- extent:(aView width @ bw).
- (r containsPoint:p) ifTrue:[^ #top:].
-
- r origin:(aView left @ (aView bottom + bw)) extent:(aView width @ bw).
- (r containsPoint:p) ifTrue:[^ #bottom:].
-
- r top:(aView top).
- r extent:(bw @ aView height).
- (r containsPoint:p) ifTrue:[^ #left:].
-
- r origin:((aView right + bw) @ aView top).
- (r containsPoint:p) ifTrue:[^ #right:].
-
- ^ nil
-
-
-! !
-
-!UIObjectView methodsFor:'selections'!
-
-addToSelection:something
- (self canSelect:something) ifTrue:[
- super addToSelection:something.
- self changed:#selection.
- ]
-!
-
-inspectSelection
- self singleSelectionDo:[:aView |
- aView inspect
- ]
-!
-
-numberOfSelections
- "return the number of selected entries"
-
- |sz|
-
- selection isNil ifTrue:[^ 0].
-
- selection isCollection ifTrue:[^ selection size]
- ifFalse:[^ 1 ]
-!
-
-removeFromSelection:something
- super removeFromSelection:something.
- self changed:#selection
-
-!
-
-select:something
- (self canSelect:something) ifTrue:[
- super select:something.
- self changed:#selection
- ]
-
-!
-
-selection
- ^ selection
-
-
-!
-
-selectionHiddenDo:aBlock
- "apply block to every object in selection"
-
- self selectionDo:[:aView |
- self showUnselected:aView.
- ].
- device flush.
- aBlock value.
- self selectionDo:[:aView |
- self showSelected:aView
- ]
-
-
-!
-
-singleSelection
- "returns single selection or nil
- "
- selection isCollection ifFalse:[
- ^ selection
- ].
- selection size == 1 ifTrue:[ ^ selection at:1]
- ifFalse:[ ^ nil].
-!
-
-singleSelectionDo:aBlock
- |view|
-
- (view := self singleSelection) notNil ifTrue:[
- aBlock value:view
- ]
-!
-
-unselect
- selection notNil ifTrue:[
- super unselect.
- self changed:#selection
- ]
-
-!
-
-withSelectionHiddenDo:aBlock
- "evaluate aBlock while selection is hidden"
-
- |sel|
-
- selection isNil ifTrue:[
- aBlock value
- ] ifFalse:[
- sel := selection.
- super unselect.
- aBlock value.
- super select:sel
- ]
-
- "Modified: 6.9.1995 / 01:46:16 / claus"
-
-
-! !
-
-!UIObjectView methodsFor:'testing'!
-
-canMove:something
- ^ true
-
-
-!
-
-canPaste:something
- "returns true if something could be paste
- "
- something notNil ifTrue:[
- something isCollection ifTrue:[
- something notEmpty ifTrue:[
- ^ (something at:1) isKindOf:UISpecification
- ]
- ] ifFalse:[
- ^ something isKindOf:UISpecification
- ]
- ].
- ^ false
-
-!
-
-canSelect:something
- ^ (testMode not and:[something ~~ selection])
-
-!
-
-hasUndos
- "returns true if undoHistory not empty
- "
- ^ undoHistory notEmpty
-!
-
-isHorizontalResizable:aComponent
- ^ self subclassResponsibility
-
-
-!
-
-isVerticalResizable:aComponent
- ^ self subclassResponsibility
-
-
-!
-
-supportsSubComponents:something
- "returns true if somrthing supports subcomponents
- "
- |specClass|
-
- something notNil ifTrue:[
- something isCollection ifFalse:[
- specClass := something specClass
- ] ifTrue:[
- something size == 1 ifTrue:[
- specClass := (something at:1) specClass
- ]
- ].
- specClass notNil ifTrue:[
- ^ specClass basicNew supportsSubComponents
- ]
- ].
- ^ false
-! !
-
-!UIObjectView 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
- "
- self subclassResponsibility
-
-
-!
-
-transaction:aType selectionDo:aOneArgBlock
- "opens a transaction and evaluates a block within the transaction; the
- argument to the block is a view from the selection
- "
- self transaction:aType objects:selection do:aOneArgBlock
-
-
-!
-
-undoBlockDimensionChanged:aView
-
- undoHistory isTransactionOpen ifTrue:[
- |layout|
-
- layout := aView geometryLayout copy.
-
- undoHistory addUndoBlock:[
- aView geometryLayout:layout.
- aView superView sizeChanged:nil.
- ]
- ]
-
-!
-
-undoBlockPositionChanged:aView
-
- undoHistory isTransactionOpen ifTrue:[
- |layout|
-
- layout := aView geometryLayout copy.
- layout isNil ifFalse:[
- undoHistory addUndoBlock:[aView geometryLayout:layout]
- ] ifTrue:[
- layout := aView pixelOrigin.
- undoHistory addUndoBlock:[aView pixelOrigin:layout]
- ]
- ]
-
-!
-
-undoDeleteAll
- "delete total undo history
- "
- undoHistory reinitialize
-!
-
-undoLast
- self undoLast:1
-!
-
-undoLast:n
-
- self unselect.
- undoHistory undoLast:n.
- self changed:#tree
-
-
-! !
-
-!UIObjectView methodsFor:'user actions - dimension'!
-
-copyExtent
- |object|
-
- object := self singleSelection.
-
- object notNil ifTrue:[
- copiedExtent := object computeExtent
- ] ifFalse:[
- self warn:'exactly one element must be selected'.
- ]
-
-
-
-!
-
-pasteExtent
- copiedExtent notNil ifTrue:[
- self transition:#extent dimensionDo:[:v|
- self resize:v corner:(v computeOrigin + copiedExtent)
- ]
- ]
-!
-
-pasteHeight
- copiedExtent notNil ifTrue:[
- self transition:'paste height' dimensionDo:[:v|
- self resize:v bottom:(v computeOrigin + copiedExtent)
- ]
- ]
-
-!
-
-pasteWidth
- copiedExtent notNil ifTrue:[
- self transition:'paste width' dimensionDo:[:v|
- self resize:v right:(v computeOrigin + copiedExtent)
- ]
- ]
-
-!
-
-setDimension:aLayout
- |type|
-
- aLayout isLayout ifTrue:[
- aLayout isLayoutFrame ifTrue:[
- type := #layoutFrame
- ] ifFalse:[
- aLayout isAlignmentOrigin ifTrue:[
- type := #layoutAlignOrigin.
- ] ifFalse:[
- type := #layoutOrigin
- ]
- ]
- ] ifFalse:[
- type := #layout
- ].
-
- self transition:type dimensionDo:[:v| v geometryLayout:(aLayout copy)]
-
-!
-
-setToDefaultExtent
- self transition:#extent dimensionDo:[:v|
- self resize:v corner:(v computeOrigin + (v preferredExtent))
- ]
-
-!
-
-setToDefaultHeight
- self transition:'default height' dimensionDo:[:v|
- self resize:v bottom:(v computeOrigin + (v preferredExtent))
- ]
-
-!
-
-setToDefaultWidth
- self transition:'default width' dimensionDo:[:v|
- self resize:v right:(v computeOrigin + (v preferredExtent))
- ]
-
-!
-
-transition:aType dimensionDo:aOneArgBlock
- "change dimension within a transaction for the selected elements by evaluating
- the block with the argument a view.
- "
- self selectionHiddenDo:[
- self transaction:aType selectionDo:[:aView|
- self undoBlockDimensionChanged:aView.
- aOneArgBlock value:aView.
- aView superView sizeChanged:nil
- ].
- self changed:#layout
- ]
-! !
-
-!UIObjectView methodsFor:'user actions - move'!
-
-moveSelectionDown:aNumber
- |gridY|
-
- gridAlign notNil ifTrue:[
- gridY := gridAlign y.
- ].
-
- self selectionHiddenDo:[
- self transaction:#move selectionDo:[:aView|
- |n d|
-
- n := aNumber.
-
- aligning ifTrue:[
- d := ((aView computeCorner y) \\ gridY).
- n := n * gridY.
-
- d ~~ 0 ifTrue:[
- n := n - d + 1.
- ]
- ].
- self shiftLayout:aView top:n bottom:n
- ].
- self changed:#layout
- ]
-
-
-!
-
-moveSelectionLeft:aNumber
- "move selection left
- "
- |gridX|
-
- gridAlign notNil ifTrue:[
- gridX := gridAlign x.
- ].
-
- self selectionHiddenDo:[
- self transaction:#move selectionDo:[:aView|
- |n d|
-
- n := aNumber.
-
- aligning ifTrue:[
- d := ((aView computeOrigin x) \\ gridX).
- d ~~ 0 ifTrue:[
- n := n-1.
- ].
- n := (n * gridX) + d.
- ].
- n := n negated.
- self shiftLayout:aView left:n right:n
-
- ].
- self changed:#layout
- ]
-!
-
-moveSelectionRight:aNumber
- "move selection right
- "
- |gridX|
-
- gridAlign notNil ifTrue:[
- gridX := gridAlign x.
- ].
-
- self selectionHiddenDo:[
- self transaction:#move selectionDo:[:aView|
- |n d|
-
- n := aNumber.
-
- aligning ifTrue:[
- d := ((aView computeCorner x) \\ gridX).
- n := n * gridX.
-
- d ~~ 0 ifTrue:[
- n := n - d + 1.
- ]
- ].
- self shiftLayout:aView left:n right:n
-
- ].
- self changed:#layout
- ]
-!
-
-moveSelectionUp:aNumber
- "move selection up
- "
- |gridY|
-
- gridAlign notNil ifTrue:[
- gridY := gridAlign y.
- ].
-
- self selectionHiddenDo:[
- self transaction:#move selectionDo:[:aView|
- |n d|
-
- n := aNumber.
-
- aligning ifTrue:[
- d := ((aView computeOrigin x) \\ gridY).
- d ~~ 0 ifTrue:[
- n := n-1.
- ].
- n := (n * gridY) + d.
- ].
- n := n negated.
- self shiftLayout:aView top:n bottom:n
- ].
- self changed:#layout
- ]
-
-
-! !
-
-!UIObjectView methodsFor:'user actions - position'!
-
-alignSelectionBottom
- |bmost delta layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- bmost := (selection at:1) computeCorner y.
-
- self transaction:#align selectionDo:[:v|
- (delta := bmost - (v computeCorner y)) ~~ 0 ifTrue:[
- self shiftLayout:v top:delta bottom:delta.
- ]
- ]
- ] ifFalse:[
- layout := selection geometryLayout.
-
- (layout isLayout and:[layout isLayoutFrame]) ifFalse:[
- ^ self
- ].
-
- self transaction:#layout selectionDo:[:aView|
- self undoBlockDimensionChanged:aView.
- layout := aView geometryLayout.
- layout bottomOffset:0.
- layout bottomFraction:1.0.
- aView geometryLayout:layout.
- ]
- ]
- ].
- self changed:#layout
- ]
-
-
-
-!
-
-alignSelectionCenterHor
- |view center|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- view := self singleSelection.
-
- view notNil ifTrue:[
- view := view superView.
- center := view computeExtent
- ] ifFalse:[
- view := selection at:1.
- center := view computeCorner + view computeOrigin.
- ].
- center := center x // 2.
-
- self transaction:#align selectionDo:[:v|
- |newX oldX delta|
-
- oldX := v computeOrigin x.
- newX := center - ((v computeCorner x - oldX) // 2).
- delta := newX - oldX.
-
- self shiftLayout:v left:delta right:delta
- ].
- self changed:#layout
- ]
- ]
-
-
-
-!
-
-alignSelectionCenterVer
- |view center|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- view := self singleSelection.
-
- view notNil ifTrue:[
- view := view superView.
- center := view computeExtent
- ] ifFalse:[
- view := selection at:1.
- center := view computeCorner + view computeOrigin.
- ].
- center := center y // 2.
-
- self transaction:#align selectionDo:[:v|
- |newY oldY delta|
-
- oldY := v computeOrigin y.
- newY := center - ((v computeCorner y - oldY) // 2).
- delta := newY - oldY.
-
- self shiftLayout:v top:delta bottom:delta
- ].
- self changed:#layout
- ]
- ]
-!
-
-alignSelectionLeft
- |lmost delta layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- lmost := (selection at:1) computeOrigin x.
-
- self transaction:#align selectionDo:[:v|
- (delta := lmost - (v computeOrigin x)) ~~ 0 ifTrue:[
- self shiftLayout:v left:delta right:delta
- ]
- ]
- ] ifFalse:[
- self transaction:#layout selectionDo:[:aView|
- layout := aView geometryLayout.
-
- layout isLayout ifTrue:[
- self undoBlockDimensionChanged:aView.
- layout leftOffset:0.
- layout leftFraction:0.0.
- aView geometryLayout:layout.
- ]
- ]
- ]
- ].
- self changed:#layout
- ]
-!
-
-alignSelectionLeftAndRight
- |lmost rmost layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- lmost := (selection at:1) computeOrigin x.
- rmost := (selection at:1) computeCorner x.
-
- self transaction:#align selectionDo:[:v|
- self shiftLayout:v left:(lmost - (v computeOrigin x))
- right:(rmost - (v computeCorner x))
- ]
- ] ifFalse:[
- self transaction:#layout selectionDo:[:aView|
- layout := aView geometryLayout.
-
- layout isLayout ifTrue:[
- self undoBlockDimensionChanged:aView.
- layout leftOffset:0.
- layout leftFraction:0.0.
-
- (layout isLayout and:[layout isLayoutFrame]) ifTrue:[
- layout rightOffset:0.
- layout rightFraction:1.0.
- ].
- aView geometryLayout:layout.
- ]
- ]
- ]
- ].
- self changed:#layout
- ]
-!
-
-alignSelectionRight
- |rmost delta layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- rmost := (selection at:1) computeCorner x.
-
- self transaction:#align selectionDo:[:v|
- (delta := rmost - (v computeCorner x)) ~~ 0 ifTrue:[
- self shiftLayout:v left:delta right:delta
- ]
- ]
- ] ifFalse:[
- layout := selection geometryLayout.
-
- (layout isLayout and:[layout isLayoutFrame]) ifFalse:[
- ^ self
- ].
-
- self transaction:#layout selectionDo:[:aView|
- self undoBlockDimensionChanged:aView.
- layout := aView geometryLayout.
- layout rightOffset:0.
- layout rightFraction:1.0.
- aView geometryLayout:layout.
- ]
- ]
- ].
- self changed:#layout
- ]
-!
-
-alignSelectionTop
- |tmost delta layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- tmost := (selection at:1) computeOrigin y.
-
- self transaction:#align selectionDo:[:v|
- (delta := tmost - (v computeOrigin y)) ~~ 0 ifTrue:[
- self shiftLayout:v top:delta bottom:delta
- ]
- ]
- ] ifFalse:[
- self transaction:#layout selectionDo:[:aView|
- layout := aView geometryLayout.
-
- layout isLayout ifTrue:[
- self undoBlockDimensionChanged:aView.
- layout topOffset:0.
- layout topFraction:0.0.
- aView geometryLayout:layout.
- ]
- ]
- ]
- ].
- self changed:#layout
- ]
-
-!
-
-alignSelectionTopAndBottom
- |tmost bmost layout|
-
- selection notNil ifTrue:[
- self selectionHiddenDo:[
- self numberOfSelections > 1 ifTrue:[
- tmost := (selection at:1) computeOrigin y.
- bmost := (selection at:1) computeCorner y.
-
- self transaction:#align selectionDo:[:v|
- self shiftLayout:v top:(tmost - (v computeOrigin y))
- bottom:(bmost - (v computeCorner y))
- ]
- ] ifFalse:[
- self transaction:#layout selectionDo:[:aView|
- layout := aView geometryLayout.
-
- layout isLayout ifTrue:[
- self undoBlockDimensionChanged:aView.
- layout topOffset:0.
- layout topFraction:0.0.
-
- (layout isLayout and:[layout isLayoutFrame]) ifTrue:[
- layout bottomOffset:0.
- layout bottomFraction:1.0.
- ].
- aView geometryLayout:layout.
- ]
- ]
- ]
- ].
- self changed:#layout
- ]
-!
-
-centerSelection:aOneArgBlockXorY orientation:orientation
- "center selection horizontal or vertical dependant on the block result( x or y).
- The argument to the block is the point.
- "
- |superview min max delta val|
-
- self selectionHiddenDo:[
- max := 0.
-
- self selectionDo:[:aView |
- superview isNil ifTrue:[
- superview := aView superView
- ] ifFalse:[
- (aView superView == superview) ifFalse:[
- ^ self notify:'views must have same superview'.
- ]
- ].
- val := aOneArgBlockXorY value:(aView computeOrigin).
-
- min isNil ifTrue:[min := val]
- ifFalse:[min := min min:val].
-
- val := aOneArgBlockXorY value:(aView computeCorner).
- max := max max:val.
- ].
-
- val := aOneArgBlockXorY value:(superview computeExtent).
- max := (min + val - max) // 2.
-
- max == min ifFalse:[
- delta := max - min.
-
- self transaction:#center selectionDo:[:v|
- orientation == #y ifTrue:[
- self shiftLayout:v top:delta bottom:delta
- ] ifFalse:[
- self shiftLayout:v left:delta right:delta
- ]
- ].
- self changed:#layout
- ]
- ]
-
-
-!
-
-centerSelectionHor
- "center selection horizontal
- "
- self centerSelection:[:aPoint| aPoint x] orientation:#x
-
-
-!
-
-centerSelectionVer
- "center selection vertical
- "
- self centerSelection:[:aPoint| aPoint y] orientation:#y
-!
-
-spreadSelectionHor
- |sumWidths min max viewsInOrder topsInOrder count space|
-
- (self numberOfSelections > 1) ifFalse:[
- ^ self
- ].
-
- self selectionHiddenDo:[
- count := 0.
- sumWidths := 0.
- max := 0.
-
- self selectionDo:[:aView |
- sumWidths := sumWidths + aView width.
-
- min isNil ifTrue:[min := aView left]
- ifFalse:[min := min min:(aView left)].
-
- max := max max:(aView right).
- count := count + 1
- ].
- viewsInOrder := Array withAll:selection.
- topsInOrder := viewsInOrder collect:[:aView | aView left].
- topsInOrder sortWith:viewsInOrder.
-
- space := (((max - min) - sumWidths) / (count - 1)) rounded asInteger.
-
- self transaction:#spread objects:viewsInOrder do:[:aView|
- |delta|
-
- delta := min - aView computeOrigin x.
- self shiftLayout:aView left:delta right:delta.
- min := min + aView computeExtent x + space
- ].
- self changed:#layout
- ]
-
-!
-
-spreadSelectionVer
- |sumHeights min max viewsInOrder topsInOrder count space|
-
- (self numberOfSelections > 1) ifFalse:[
- ^ self
- ].
-
- self selectionHiddenDo:[
- count := 0.
- sumHeights := 0.
- max := 0.
-
- self selectionDo:[:aView |
- sumHeights := sumHeights + aView height.
-
- min isNil ifTrue:[min := aView top]
- ifFalse:[min := min min:(aView top)].
-
- max := max max:(aView bottom).
- count := count + 1
- ].
- viewsInOrder := Array withAll:selection.
- topsInOrder := viewsInOrder collect:[:aView|aView top].
- topsInOrder sortWith:viewsInOrder.
-
- space := (((max - min) - sumHeights) / (count - 1)) rounded asInteger.
-
- self transaction:#spread objects:viewsInOrder do:[:aView|
- |delta|
-
- delta := min - aView computeOrigin y.
- self shiftLayout:aView top:delta bottom:delta.
- min := min + aView height + space
- ].
- self changed:#layout
- ]
-! !
-
-!UIObjectView::UndoHistory class methodsFor:'constants'!
-
-maxHistorySize
- "returns maximum size of history before removing oldest
- record
- "
- ^ 50
-
-
-! !
-
-!UIObjectView::UndoHistory class methodsFor:'instance creation'!
-
-new
- ^ self basicNew initialize
-
-
-! !
-
-!UIObjectView::UndoHistory methodsFor:'accessing'!
-
-historySize
- ^ history size
-! !
-
-!UIObjectView::UndoHistory methodsFor:'initialization'!
-
-initialize
- super initialize.
- self reinitialize.
-
-
-!
-
-reinitialize
- "reinitialize all attributes
- "
- history := OrderedCollection new.
- transaction := nil.
- enabled := true.
-
-
-! !
-
-!UIObjectView::UndoHistory methodsFor:'menu'!
-
-popupMenu
- "returns a submenu for undo
- "
- |labels|
-
- labels := OrderedCollection new:(history size).
- history reverseDo:[:aRecord| labels add:(aRecord asString) ].
-
- ^ PopUpMenu labels:labels selectors:#undoLast:.
-
-! !
-
-!UIObjectView::UndoHistory methodsFor:'testing'!
-
-isEmpty
- "returns true if undo history is empty
- "
- ^ history isEmpty
-
-
-!
-
-isTransactionOpen
- ^ (enabled and:[transaction notNil])
-!
-
-notEmpty
- "returns true if undo history is not empty
- "
- ^ history notEmpty
-
-
-! !
-
-!UIObjectView::UndoHistory methodsFor:'transaction'!
-
-addUndoBlock:anUndoBlock
- "undo block to restore changes; add block to current transaction
- "
- self isTransactionOpen ifTrue:[
- transaction add:anUndoBlock
- ]
-
-
-!
-
-disabledTransitionDo:aBlock
- "disable transitions during evaluating the block
- "
- |oldState|
-
- oldState := enabled.
- enabled := false.
- aBlock value.
- enabled := oldState.
-!
-
-transaction:aType do:aBlock
- self transaction:aType text:nil do:aBlock
-!
-
-transaction:aType text:aTextOrNil do:aBlock
- "open a transaction; perform the block; at least close the transaction
- "
- (enabled and:[transaction isNil]) ifTrue:[
- transaction := Transaction type:aType text:aTextOrNil.
-
- aBlock value.
-
- transaction isEmpty ifFalse:[
- history addLast:transaction.
- history size > (self class maxHistorySize) ifTrue:[history removeFirst]
- ].
- transaction := nil
-
- ] ifFalse:[
- aBlock value
- ]
-! !
-
-!UIObjectView::UndoHistory methodsFor:'undo'!
-
-undoLast:nTransactions
- "undo last n transactions; an open transaction will be closed;
- transactions during undo are disabled
- "
- |n|
-
- transaction := nil.
- n := nTransactions min:(history size).
-
- n ~~ 0 ifTrue:[
- enabled := false.
- n timesRepeat:[ (history removeLast) undo ].
- enabled := true.
- ]
-
-
-! !
-
!UIObjectView::UndoHistory::Transaction class methodsFor:'instance creation'!
type:aType text:aTextOrNil
@@ -1997,7 +22,7 @@
string := type asString.
- text notNil ifTrue:[^ string, ' ', text ]
+ text notNil ifTrue:[^ string, ' ', text ]
ifFalse:[^ string ]
!
@@ -2073,8 +98,3 @@
^ actions notNil
! !
-!UIObjectView class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-! !
--- a/UIPainter.st Fri Feb 21 20:33:57 1997 +0100
+++ b/UIPainter.st Tue Feb 25 14:15:56 1997 +0100
@@ -1,26 +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.
-"
-
-ApplicationModel subclass:#UIPainter
- instanceVariableNames:'menu nameField elementMenu workView treeView outletView stringBox
- actionBox listBox fileBox currentFileName topView propertyFrame
- whichProperty nameChannel applyAction specClass specSelector
- specSuperclass aspectHolders specShown specSpecificAspectHolders
- claus'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-UIPainter'
-!
-
HorizontalPanelView subclass:#ButtonPanel
instanceVariableNames:'receiver argumentToSelector'
classVariableNames:''
@@ -28,2853 +5,6 @@
privateIn:UIPainter
!
-!UIPainter 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.
-
- [start with:]
- UIPainter open
-"
-! !
-
-!UIPainter class methodsFor:'interface specs'!
-
-actionButtonModelSpec
- "UIPainter new openOnClass:self andSelector:#actionButtonModelSpec"
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#FramedBoxSpec
- #'layout:' #(#LayoutFrame 0 0 -1 0 251 0 289 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 6 0 26 0 78 0 216 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 47 0 57 0 71 0)
- #'label:' 'aspect:'
- )
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 119 0 62 0 143 0)
- #'label:' 'change:'
- )
- )
- )
- #'horizontalLayout:' #left
- #'verticalLayout:' #spreadSpace
- )
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 80 0 24 0 231 0 214 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#InputFieldSpec
- #'name:' 'aspectInput'
- #'layout:' #(#LayoutFrame 0 0 49 0 163 0 69 0)
- #model: #aspectChannel
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'changeInput'
- #'layout:' #(#LayoutFrame 0 0 119 0 163 0 142 0)
- #model: #changeChannel
- #acceptOnLostFocus: true
- #tabable: true
- )
- )
- )
- #'horizontalLayout:' #fit
- #'verticalLayout:' #spreadSpace
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 102 0 246 0 153 0 272 0)
- #'label:' 'apply'
- #'model:' #setModelAspects
- )
- )
- )
- #'labelPosition:' #topLeft
- #'showFrame:' false
- )
- )
- )
- #'window:'
- #(#WindowSpec
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 255 292)
- )
- )
-!
-
-cancelAndApplySpec
- "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:UIPainter andSelector:#cancelAndApplySpec
- UIPainter new openInterface:#cancelAndApplySpec
- "
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 225 45)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#ActionButtonSpec
- #'name:' 'cancel'
- #'layout:' #(#LayoutFrame 26 0 13 0 77 0 35 0)
- #'label:' 'cancel'
- #'model:' #cancel
- )
- #(#ActionButtonSpec
- #'name:' 'apply'
- #'layout:' #(#LayoutFrame 139 0 13 0 190 0 35 0)
- #'label:' 'apply'
- #'model:' #apply
- )
- )
- )
- )
-!
-
-colorSpec
- "UIBuilder new openOnClass:self andSelector:#colorSpec"
- "Builder new openInterface:#colorSpec"
-
- <resource: #canvas>
- ^
-
- #(#FullSpec
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#FramedBoxSpec
- #'layout:' #(#LayoutFrame 0 0 -1 0 252 0 290 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 6 0 26 0 100 0 215 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 47 0 87 0 71 0)
- #'label:' 'foreground:'
- )
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 119 0 93 0 143 0)
- #'label:' 'background:'
- )
- )
- )
- #'horizontalLayout:' #left
- #'verticalLayout:' #spreadSpace
- )
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 114 0 24 0 233 0 213 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#InputFieldSpec
- #'layout:' #(#LayoutFrame 0 0 49 0 163 0 69 0)
- #model: #foregroundColor
- #acceptOnLostFocus: true
- #tabable: true
-
- )
- #(#InputFieldSpec
- #'layout:' #(#LayoutFrame 0 0 119 0 163 0 142 0)
- #model: #backgroundColor
- #acceptOnLostFocus: true
- #tabable: true
-
- )
- )
- )
- #'horizontalLayout:' #fit
- #'verticalLayout:' #spreadSpace
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 102 0 246 0 153 0 272 0)
- #'label:' 'apply'
- #'model:' #setColors
- #tabable: true
-
- )
- )
- )
- #'labelPosition:' #topLeft
- #'showFrame:' false
- )
- )
- )
- #'window:'
- #(#WindowSpec
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 255 292)
- )
- )
-!
-
-geometrySpecForAlignmentOrigin
- "
- UIPainter new openOnClass:self andSelector:#geometrySpecForAlignmentOrigin
- "
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 248 304)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label1'
- #'layout:' #(#LayoutFrame 5 0 42 0 48 0 60 0)
- #'label:' 'left'
- )
- #(#LabelSpec
- #'name:' 'label2'
- #'layout:' #(#LayoutFrame 5 0 69 0 48 0 87 0)
- #'label:' 'top'
- )
- #(#LabelSpec
- #'name:' 'label3'
- #'layout:' #(#LayoutFrame 57 0 10 0 103 0 27 0)
- #'label:' 'relative'
- )
- #(#LabelSpec
- #'name:' 'label4'
- #'layout:' #(#LayoutFrame 154 0 11 0 190 0 28 0)
- #'label:' 'offset'
- )
- #(#LabelSpec
- #'name:' 'label5'
- #'layout:' #(#LayoutFrame 5 0 96 0 48 0 114 0)
- #'label:' 'align H'
- )
- #(#LabelSpec
- #'name:' 'label6'
- #'layout:' #(#LayoutFrame 5 0 122 0 48 0 140 0)
- #'label:' 'align V'
- )
- #(#InputFieldSpec
- #'name:' 'editField1'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 57 0 42 0 114 0 60 0)
- #'model:' #leftFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField2'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 57 0 69 0 114 0 87 0)
- #'model:' #topFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField5'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 57 0 96 0 114 0 114 0)
- #'model:' #leftAlignmentFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField6'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 56 0 122 0 113 0 140 0)
- #'model:' #topAlignmentFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField3'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 154 0 42 0 212 0 60 0)
- #'model:' #leftOffset
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField4'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 154 0 69 0 212 0 87 0)
- #'model:' #topOffset
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#ActionButtonSpec
- #'name:' 'button1'
- #'layout:' #(#LayoutFrame 119 0 42 0 138 0 60 0)
- #'label:' ''
- #'model:' #makeRelativeLeft
- )
- #(#ActionButtonSpec
- #'name:' 'button2'
- #'layout:' #(#LayoutFrame 119 0 69 0 138 0 87 0)
- #'label:' ''
- #'model:' #makeRelativeTop
- )
- #(#ActionButtonSpec
- #'name:' 'button3'
- #'layout:' #(#LayoutFrame 216 0 42 0 235 0 60 0)
- #'label:' ''
- #'model:' #makeOffsetLeft
- )
- #(#ActionButtonSpec
- #'name:' 'button4'
- #'layout:' #(#LayoutFrame 216 0 69 0 235 0 87 0)
- #'label:' ''
- #'model:' #makeOffsetTop
- )
-
-
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
- #'label:' 'frame'
- #'model:' #setLayoutFrame
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
- #'label:' 'origin'
- #'model:' #setLayoutOrigin
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
- #'label:' 'align'
- #'model:' #setAlignmentOrigin
- #'initiallyDisabled:' true
- )
- #(#ActionButtonSpec
- #'layout:' #(#LayoutFrame 96 0 260 0 156 0 290 0)
- #'label:' 'apply'
- #'model:' #setDimensionForLayoutFrame
- #tabable: true
- )
-
- )
- )
- )
-
-
-!
-
-geometrySpecForLayoutFrame
- "
- UIPainter new openOnClass:self andSelector:#geometrySpecForLayoutFrame
- "
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 300 300)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label left'
- #'layout:' #(#LayoutFrame 12 0 39 0 53 0 57 0)
- #'label:' 'left'
- )
- #(#LabelSpec
- #'name:' 'label top'
- #'layout:' #(#LayoutFrame 12 0 67 0 53 0 85 0)
- #'label:' 'top'
- )
- #(#LabelSpec
- #'name:' 'label right'
- #'layout:' #(#LayoutFrame 12 0 95 0 53 0 113 0)
- #'label:' 'right'
- )
- #(#LabelSpec
- #'name:' 'label bottom'
- #'layout:' #(#LayoutFrame 12 0 123 0 53 0 141 0)
- #'label:' 'bottom'
- )
- #(#LabelSpec
- #'name:' 'label relative'
- #'layout:' #(#LayoutFrame 65 0 6 0 110 0 24 0)
- #'label:' 'relative'
- )
- #(#LabelSpec
- #'name:' 'label offset'
- #'layout:' #(#LayoutFrame 159 0 6 0 190 0 24 0)
- #'label:' 'offset'
- )
- #(#LabelSpec
- #'name:' 'label all relative'
- #'layout:' #(#LayoutFrame 12 0 157 0 53 0 175 0)
- #'label:' 'all'
- )
- #(#LabelSpec
- #'name:' 'label all absolute'
- #'layout:' #(#LayoutFrame 159 0 157 0 210 0 175 0)
- #'label:' 'all'
- )
- #(#InputFieldSpec
- #'name:' 'relative E1'
- #'layout:' #(#LayoutFrame 65 0 39 0 113 0 57 0)
- #'model:' #leftFraction
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'relative E2'
- #'layout:' #(#LayoutFrame 65 0 67 0 113 0 85 0)
- #'model:' #topFraction
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'relative E3'
- #'layout:' #(#LayoutFrame 65 0 95 0 113 0 113 0)
- #'model:' #rightFraction
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'relative E4'
- #'layout:' #(#LayoutFrame 65 0 123 0 113 0 141 0)
- #'model:' #bottomFraction
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'offset E1'
- #'layout:' #(#LayoutFrame 159 0 39 0 210 0 57 0)
- #'model:' #leftOffset
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'offset E2'
- #'layout:' #(#LayoutFrame 159 0 67 0 210 0 85 0)
- #'model:' #topOffset
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'offset E3'
- #'layout:' #(#LayoutFrame 159 0 95 0 210 0 113 0)
- #'model:' #rightOffset
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#InputFieldSpec
- #'name:' 'offset E4'
- #'layout:' #(#LayoutFrame 159 0 123 0 210 0 141 0)
- #'model:' #bottomOffset
- #'type:' #numberOrNil
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- #'acceptOnLostFocus:' true
- )
- #(#ActionButtonSpec
- #'name:' 'relative B1'
- #'layout:' #(#LayoutFrame 117 0 39 0 136 0 57 0)
- #'label:' ''
- #'model:' #makeRelativeLeft
- )
- #(#ActionButtonSpec
- #'name:' 'relative B2'
- #'layout:' #(#LayoutFrame 117 0 67 0 136 0 85 0)
- #'label:' ''
- #'model:' #makeRelativeTop
- )
- #(#ActionButtonSpec
- #'name:' 'relative B3'
- #'layout:' #(#LayoutFrame 117 0 95 0 136 0 113 0)
- #'label:' ''
- #'model:' #makeRelativeRight
- )
- #(#ActionButtonSpec
- #'name:' 'relative B4'
- #'layout:' #(#LayoutFrame 117 0 123 0 136 0 141 0)
- #'label:' ''
- #'model:' #makeRelativeBottom
- )
- #(#ActionButtonSpec
- #'name:' 'relative BAll'
- #'layout:' #(#LayoutFrame 117 0 157 0 136 0 175 0)
- #'label:' ''
- #'model:' #makeRelativeAll
- )
- #(#ActionButtonSpec
- #'name:' 'offset B1'
- #'layout:' #(#LayoutFrame 214 0 39 0 233 0 57 0)
- #'label:' ''
- #'model:' #makeOffsetLeft
- )
- #(#ActionButtonSpec
- #'name:' 'offset B2'
- #'layout:' #(#LayoutFrame 214 0 67 0 233 0 85 0)
- #'label:' ''
- #'model:' #makeOffsetTop
- )
- #(#ActionButtonSpec
- #'name:' 'offset B3'
- #'layout:' #(#LayoutFrame 214 0 95 0 233 0 113 0)
- #'label:' ''
- #'model:' #makeOffsetRight
- )
- #(#ActionButtonSpec
- #'name:' 'offset B4'
- #'layout:' #(#LayoutFrame 214 0 123 0 233 0 141 0)
- #'label:' ''
- #'model:' #makeOffsetBottom
- )
- #(#ActionButtonSpec
- #'name:' 'offset BAll'
- #'layout:' #(#LayoutFrame 214 0 157 0 233 0 175 0)
- #'label:' ''
- #'model:' #makeOffsetAll
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
- #'label:' 'frame'
- #'model:' #setLayoutFrame
- )
- #(#ActionButtonSpec
- #'name:' 'button10'
- #'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
- #'label:' 'origin'
- #'model:' #setLayoutOrigin
- )
- #(#ActionButtonSpec
- #'name:' 'button11'
- #'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
- #'label:' 'align'
- #'model:' #setAlignmentOrigin
- )
- #(#ActionButtonSpec
- #'name:' 'button12'
- #'layout:' #(#LayoutFrame 96 0 260 0 156 0 290 0)
- #'label:' 'apply'
- #'model:' #setDimensionForLayoutFrame
- )
- )
- )
- )
-
-
-!
-
-geometrySpecForLayoutOrigin
- "
- UIPainter new openOnClass:self andSelector:#geometrySpecForLayoutOrigin
- "
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 248 304)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label1'
- #'layout:' #(#LayoutFrame 16 0 42 0 44 0 60 0)
- #'label:' 'left'
- )
- #(#LabelSpec
- #'name:' 'label2'
- #'layout:' #(#LayoutFrame 16 0 69 0 44 0 87 0)
- #'label:' 'top'
- )
- #(#LabelSpec
- #'name:' 'label3'
- #'layout:' #(#LayoutFrame 57 0 10 0 103 0 27 0)
- #'label:' 'relative'
- )
- #(#LabelSpec
- #'name:' 'label4'
- #'layout:' #(#LayoutFrame 154 0 11 0 190 0 28 0)
- #'label:' 'offset'
- )
- #(#InputFieldSpec
- #'name:' 'editField1'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 57 0 42 0 114 0 60 0)
- #'model:' #leftFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField2'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 57 0 69 0 114 0 87 0)
- #'model:' #topFraction
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField3'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 154 0 42 0 212 0 60 0)
- #'model:' #leftOffset
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'editField4'
- #'type:' #numberOrNil
- #'layout:' #(#LayoutFrame 154 0 69 0 212 0 87 0)
- #'model:' #topOffset
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#ActionButtonSpec
- #'name:' 'button1'
- #'layout:' #(#LayoutFrame 119 0 42 0 138 0 60 0)
- #'label:' ''
- #'model:' #makeRelativeLeft
- )
- #(#ActionButtonSpec
- #'name:' 'button2'
- #'layout:' #(#LayoutFrame 119 0 69 0 138 0 87 0)
- #'label:' ''
- #'model:' #makeRelativeTop
- )
- #(#ActionButtonSpec
- #'name:' 'button3'
- #'layout:' #(#LayoutFrame 216 0 42 0 235 0 60 0)
- #'label:' ''
- #'model:' #makeOffsetLeft
- )
- #(#ActionButtonSpec
- #'name:' 'button4'
- #'layout:' #(#LayoutFrame 216 0 69 0 235 0 87 0)
- #'label:' ''
- #'model:' #makeOffsetTop
- )
-
-
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
- #'label:' 'frame'
- #'model:' #setLayoutFrame
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
- #'label:' 'origin'
- #'model:' #setLayoutOrigin
- #'initiallyDisabled:' true
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
- #'label:' 'align'
- #'model:' #setAlignmentOrigin
- )
- #(#ActionButtonSpec
- #'layout:' #(#LayoutFrame 96 0 260 0 156 0 290 0)
- #'label:' 'apply'
- #'model:' #setDimensionForLayoutFrame
- #tabable: true
- )
-
- )
- )
- )
-
-
-!
-
-miscSpec
- "UIBuilder new openOnClass:self andSelector:#miscSpec"
- "Builder new openInterface:#miscSpec"
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#FramedBoxSpec
- #'layout:' #(#LayoutFrame 0 0 -1 0 251 0 289 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 6 0 26 0 61 0 215 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'layout:' #(#LayoutFrame 0 0 47 0 57 0 71 0)
- #'label:' 'name:'
- )
- )
- )
- #'horizontalLayout:' #left
- #'verticalLayout:' #spreadSpace
- )
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 60 0 24 0 230 0 213 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#InputFieldSpec
- #model: #nameChannel
- #'layout:' #(#LayoutFrame 0 0 49 0 163 0 69 0)
- #acceptOnLostFocus: true
- #tabable: true
- )
- )
- )
- #'horizontalLayout:' #fit
- #'verticalLayout:' #spreadSpace
- )
- #(#ActionButtonSpec
- #'layout:' #(#LayoutFrame 102 0 246 0 153 0 272 0)
- #'label:' 'apply'
- #'model:' #setMiscAspects
- #tabable: true
- )
- )
- )
- #'labelPosition:' #topLeft
- #'showFrame:' false
- )
- )
- )
- #'window:'
- #(#WindowSpec
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 255 292)
- )
- )
-!
-
-modelSpec
- "UIBuilder new openOnClass:self andSelector:#modelSpec"
- "Builder new openInterface:#modelSpec"
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#FramedBoxSpec
- #'layout:' #(#LayoutFrame 0 0 -1 0 251 0 289 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 6 0 26 0 78 0 216 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 47 0 57 0 71 0)
- #'label:' 'aspect:'
- )
- #(#LabelSpec
- #'name:' 'label'
- #'layout:' #(#LayoutFrame 0 0 119 0 62 0 143 0)
- #'label:' 'change:'
- )
- )
- )
- #'horizontalLayout:' #left
- #'verticalLayout:' #spreadSpace
- )
- #(#VerticalPanelViewSpec
- #'layout:' #(#LayoutFrame 80 0 24 0 231 0 214 0)
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#InputFieldSpec
- #'name:' 'aspectInput'
- #'layout:' #(#LayoutFrame 0 0 49 0 163 0 69 0)
- #model: #aspectChannel
- #acceptOnLostFocus: true
- #tabable: true
- )
- #(#InputFieldSpec
- #'name:' 'changeInput'
- #'layout:' #(#LayoutFrame 0 0 119 0 163 0 142 0)
- #model: #changeChannel
- #acceptOnLostFocus: true
- #tabable: true
- )
- )
- )
- #'horizontalLayout:' #fit
- #'verticalLayout:' #spreadSpace
- )
- #(#ActionButtonSpec
- #'name:' 'button'
- #'layout:' #(#LayoutFrame 102 0 246 0 153 0 272 0)
- #'label:' 'apply'
- #'model:' #setModelAspects
- )
- )
- )
- #'labelPosition:' #topLeft
- #'showFrame:' false
- )
- )
- )
- #'window:'
- #(#WindowSpec
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 255 292)
- )
- )
-!
-
-nameAndSelectorSpec
- "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:self andSelector:#nameAndSelectorSpec"
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 300 300)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#LabelSpec
- #'name:' 'label1'
- #'layout:' #(#LayoutFrame 10 0 50 0 110 0 70 0)
- #'label:' 'class:'
- #'adjust:' #right
- )
- #(#LabelSpec
- #'name:' 'label2'
- #'layout:' #(#LayoutFrame 10 0 90 0 110 0 110 0)
- #'label:' 'superclass:'
- #'adjust:' #right
- )
- #(#LabelSpec
- #'name:' 'label3'
- #'layout:' #(#LayoutFrame 10 0 130 0 110 0 150 0)
- #'label:' 'selector:'
- #'adjust:' #right
- )
- #(#InputFieldSpec
- #'name:' 'classNameField'
- #'layout:' #(#LayoutFrame 120 0 50 0 289 0 69 0)
- #'model:' #classNameChannel
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- )
- #(#InputFieldSpec
- #'name:' 'superclassNameField'
- #'layout:' #(#LayoutFrame 120 0 90 0 289 0 109 0)
- #'model:' #superclassNameChannel
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- )
- #(#InputFieldSpec
- #'name:' 'methodNameField'
- #'layout:' #(#LayoutFrame 120 0 130 0 289 0 149 0)
- #'model:' #methodNameChannel
- #'immediateAccept:' false
- #'acceptOnLeave:' true
- #'acceptOnReturn:' true
- #'acceptOnTab:' true
- )
- #(#ActionButtonSpec
- #'name:' 'button1'
- #'layout:' #(#LayoutFrame 30 0 250 0 129 0 279 0)
- #'label:' 'cancel'
- #'model:' #cancel
- )
- #(#ActionButtonSpec
- #'name:' 'button2'
- #'layout:' #(#LayoutFrame 160 0 250 0 259 0 279 0)
- #'label:' 'ok'
- #'model:' #accept
- )
- )
- )
- )
-
-
-
-!
-
-propertyFrameSpec
- "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:UIPainter andSelector:#propertyFrameSpec"
- "UIPainter new openInterface:#propertyFrameSpec"
-
- <resource: #canvas>
-
- ^
-
- #(#FullSpec
- #'window:'
- #(#WindowSpec
- #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
- #'label:' 'unnamed'
- #'bounds:' #(#Rectangle 0 0 309 326)
- )
- #'component:'
- #(#SpecCollection
- #'collection:'
- #(
- #(#ArbitraryComponentSpec
- #'name:' 'view1'
- #'layout:' #(#LayoutFrame 0 0 0 0 0 1.0 -40 1.0)
- )
- #(#ActionButtonSpec
- #'name:' 'button1'
- #'layout:' #(#LayoutFrame 108 0 291 0 200 0 323 0)
- #'label:' 'apply'
- )
- )
- )
- )
-! !
-
-!UIPainter methodsFor:'BuilderView interface'!
-
-update:something
- |singleSelection|
-
- elementMenu deselect.
-
- singleSelection := workView singleSelection.
-
- something == #selection ifTrue:[
- claus setupView:singleSelection.
- ].
-
- (something == #layout or:[something == #any]) ifTrue:[
- singleSelection notNil ifTrue:[
- self fetchLayoutFrom:singleSelection
- ].
- ^ self
- ].
-
- (something == #aspects or:[something == #any]) ifTrue:[
- singleSelection notNil ifTrue:[
- self fetchModelAspectsFrom:singleSelection
- ].
- ^ self
- ].
-
- (something == #selection or:[something == #any]) ifTrue:[
- self showPropertyView.
- self showOutletsFor:(workView selection).
-
- singleSelection isNil ifFalse:[
- nameChannel isNil ifTrue:[self nameChannel].
- nameChannel value:singleSelection name.
-
- self fetchLayoutFrom:singleSelection.
- self fetchColorsFrom:singleSelection.
- self fetchModelAspectsFrom:singleSelection.
- ].
- ^ self
- ].
-! !
-
-!UIPainter methodsFor:'aspects'!
-
-aspectFor:aKey
- ^ specSpecificAspectHolders at:aKey ifAbsent:[
- aspectHolders at:aKey ifAbsent:[
- super aspectFor:aKey
- ]
- ]
-
-!
-
-nameChannel
- nameChannel isNil ifTrue:[
- nameChannel := '' asValue.
- ].
- ^ nameChannel
-
- "Modified: 6.9.1995 / 00:38:00 / claus"
-! !
-
-!UIPainter methodsFor:'filein & fileout'!
-
-openFile:aFileName
- |aStream |
-
- aStream := FileStream readonlyFileNamed:aFileName.
- aStream notNil ifTrue:[
- workView fileInContentsFrom:aStream.
- aStream close.
- currentFileName := aFileName
- ]
-
-!
-
-saveAs:aFileName
- |aStream|
-
- aStream := FileStream newFileNamed:aFileName.
- aStream notNil ifTrue:[
- workView storeContentsOn:aStream.
- aStream close
- ].
- currentFileName := aFileName
-
-! !
-
-!UIPainter methodsFor:'help'!
-
-helpTextFor:aComponent
- |sel|
-
- (aComponent isKindOf:Button) ifTrue:[
- (sel := aComponent changeMessage) notNil ifTrue:[
- "/ take the buttons change symbol as resource-key
- ^ resources string:(sel asString)
- ]
- ].
- ^ nil
-
- "Modified: 31.8.1995 / 20:49:58 / claus"
-! !
-
-!UIPainter methodsFor:'initialization'!
-
-createCanvas
- |topView|
-
- super initialize.
-
- topView := StandardSystemView new.
- topView label:'unnamed'.
- topView extent:300@300.
- topView application:self.
-
- workView := UIPainterView in:topView.
- workView layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout.
-
- ^ workView.
-
- "Builder new createCanvas open"
-!
-
-createPaletteIn:aViewOrNil
- |topView v|
-
- aViewOrNil isNil ifTrue:[
- topView := StandardSystemView new.
- topView label:'element palette'.
- topView extent:200@400.
- ] ifFalse:[
- topView := aViewOrNil
- ].
- v := HVScrollableView for:SelectionInListView miniScrollerH:true in:topView.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- elementMenu := v scrolledView.
-
- ^ elementMenu.
-
- "(Builder new createPaletteIn:nil) topView open"
-
- "Modified: 5.9.1995 / 23:52:57 / claus"
-!
-
-initChannels
- |cls|
-
- specSpecificAspectHolders := IdentityDictionary new.
- aspectHolders := IdentityDictionary new.
-
- aspectHolders at:#classNameChannel put:(
- (specClass notNil ifTrue:[specClass]
- ifFalse:['NewApplication']) asValue
- ).
- specSuperclass isNil ifTrue:[
- specClass notNil ifTrue:[
- (cls := Smalltalk at:specClass asSymbol) notNil ifTrue:[
- specSuperclass := cls superclass name.
- ]
- ]
- ].
- aspectHolders at:#superclassNameChannel put:(
- (specSuperclass notNil ifTrue:[specSuperclass]
- ifFalse:['ApplicationModel']) asValue
- ).
- aspectHolders at:#methodNameChannel put:(
- (specSelector notNil ifTrue:[specSelector]
- ifFalse:[#windowSpec]) asValue
- ).
-
- aspectHolders at:#aspectChannel put:(ValueHolder new).
- aspectHolders at:#changeChannel put:(ValueHolder new).
-
- aspectHolders at:#foregroundColor put:(ValueHolder new).
- aspectHolders at:#backgroundColor put:(ValueHolder new).
-
- #( bottomFraction leftFraction topFraction rightFraction leftAlignmentFraction
- bottomOffset leftOffset topOffset rightOffset topAlignmentFraction
- )
- do:[:aChannel| aspectHolders at:aChannel put:(ValueHolder new) ].
-!
-
-initPullDownMenu
- menu labels:(resources array:#(
- 'file'
- 'font'
- 'type'
- 'align'
- 'dimension'
- 'special'
- 'code'
- 'test'
- )).
-
- menu selectors:#(#file
- #font
- #type
- #align
- #dimension
- #special
- #code
- #test
- ).
-
- menu at:#file
- putLabels:(resources array:
- #('new'
- 'from class ...'
- 'pick a view '
- '-'
- 'save'
- 'save as ...'
- '-'
- 'install'
- '-'
-"/ 'source'
- 'windowSpec'
- 'inspect me'
- '-'
- 'print'
- '-'
- 'quit'
- ))
- selectors:#(doNew
- doFromClass
- doPickAView
- nil
- doSave
- doSaveAs
- nil
- doInstall
- nil
-"/ doSource
- doWindowSpec
- inspect
- nil
- doPrint
- nil
- doFinish
- )
- receiver:self.
-
- menu at:#font putMenu:(workView subMenuFont menuView).
-
- menu at:#type
- putLabels:(resources array:#(
- 'basic widgets'
- 'layout'
- 'text'
- 'interactors'
- 'modal'
- 'other'
- '-'
- 'all'
- ) )
- selectors:#(showBasicWidgets
- showLayoutWidgets
- showTextWidgets
- showInteractorWidgets
- showModalWidgets
- showOtherWidgets
- nil
- showAllWidgets
- )
- receiver:self.
-
- menu at:#align putMenu:(workView subMenuAlign menuView).
- menu at:#dimension putMenu:(workView subMenuDimension menuView).
-
- menu at:#special
- putLabels:(resources array:#(
- 'group radioButtons'
- 'group enterFields'
- '-'
- 'delete undo history'
- ) )
- selectors:#(
- groupRadioButtons
- groupEnterFields
- nil
- undoDeleteAll
- )
- receiver:workView.
-
- menu at:#code
- putLabels:(resources array:#(
- 'class & method'
- ) )
- selectors:#(
- defineClassAndSelector
- )
- receiver:self.
-
- menu at:#test
- putLabels:(resources array:#(
- 'test on'
- ) )
- selectors:#(toggleTest
- )
- receiver:self.
-!
-
-openInterface
- |list v topInset menuInset leftPanel middlePanel rightPanel buttonPanel propSelector|
-
- super initialize.
-
- self initChannels.
-
- whichProperty := SelectionInList new.
-"/ whichProperty list:#('dimension' 'colors' 'model' 'misc' 'attribute list').
- whichProperty list:(UISpecification slices collect:[:slice | slice first asString]).
- whichProperty onChangeSend:#showPropertyView to:self.
-
- workView :=self createCanvas.
-
- topView := StandardSystemView new.
- topView label:'Interface Builder'.
- topView icon:(Image fromFile:'bitmaps/Builder.xbm' resolution:100).
- topView extent:(600 @ 400).
-
- menu := PullDownMenu in:topView.
- buttonPanel := ButtonPanel in:topView.
-
- menuInset := menu preferredExtent y.
- topInset := menuInset + buttonPanel preferredExtent y.
-
- buttonPanel origin:0.0@menuInset corner:1.0@topInset.
- buttonPanel receiver:workView.
- leftPanel := View origin:(0.0 @ 0.0) corner:0.3@1.0 in:topView.
- leftPanel topInset:topInset.
- middlePanel := View origin:(0.3 @ 0.0) corner:0.6@1.0 in:topView.
- middlePanel topInset:topInset.
- rightPanel := View origin:(0.6 @ 0.0) corner:1.0@1.0 in:topView.
- rightPanel topInset:topInset.
-
- v := HVScrollableView for:UIPainterTreeView miniScrollerH:true in:middlePanel.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- treeView := v scrolledView.
-
- propSelector := PopUpList label:'properties' in:rightPanel.
- propSelector origin:(0.0 @ 0.0) corner:1.0@(propSelector preferredExtent y).
- propSelector horizontalInset:View viewSpacing.
- propSelector model:whichProperty.
-
- propertyFrame := View in:rightPanel.
- propertyFrame origin:(0.0 @ 0.0) corner:1.0@1.0.
- propertyFrame topInset:propSelector height + View viewSpacing.
-
- claus := View origin:(0.0 @ 0.0) corner:1.0@1.0 in:rightPanel.
- claus := UIPropertyView in:claus receiver:workView.
-
- elementMenu := self createPaletteIn:leftPanel.
-
- treeView builderView:workView. "link workview with treeview"
-
- workView addDependent:treeView.
- workView addDependent:self.
-
- self initPullDownMenu.
-
- elementMenu action:[:selection |
- workView testMode ifTrue:[
- elementMenu deselect
- ] ifFalse:[
- selection notNil ifTrue:[
- workView createWidgetWithClass:
- (Smalltalk at:(elementMenu selectionValue asSymbol))
- ]
- ]
- ].
- topView application:self.
- builder window:topView.
-
- topView beMaster.
- workView topView beSlave.
-
- "/ can be created as embedded or side-menu
- elementMenu topView ~~ topView ifTrue:[
- elementMenu topView beSlave.
- ].
-
- topView open.
- workView topView openInGroup:(topView windowGroup).
- elementMenu topView ~~ topView ifTrue:[
- elementMenu topView openInGroup:(topView windowGroup).
- ]
-
- "
- Builder open
- "
-
- "Modified: 6.9.1995 / 00:26:59 / claus"
-!
-
-openNewWindowCanvas
- self open.
-
-
-!
-
-openOnClass:aClass andSelector:aSelector
- "open up an interface builder, fetching a spec from someClass
- via some selector"
-
- |specArray|
-
- specClass := aClass name.
- specSuperclass := aClass superclass name.
- specSelector := aSelector.
-
- self openInterface.
- workView className:aClass name.
- workView methodName:aSelector.
- workView setupFromSpec:(aClass perform:aSelector).
-!
-
-openOnSpec:aSpecOrSpecArray
- "open up an interface builder, given some specArray"
-
- |newBuilder|
-
- newBuilder := self new.
-! !
-
-!UIPainter methodsFor:'make layout'!
-
-makeLayout:what xOrY:xOrY offset:aBool
- |view layout extent fraction offset fractSymb offsetSymb|
-
- view := workView singleSelection.
-
- view isNil ifTrue:[
- ^ self
- ].
- layout := view geometryLayout.
-
- layout isLayout ifFalse:[
- ^ self
- ].
- fractSymb := (what, 'Fraction') asSymbol.
- offsetSymb := (what, 'Offset') asSymbol.
-
- ( (layout respondsTo:fractSymb)
- and:[layout respondsTo:offsetSymb]
- ) ifTrue:[
-
- fraction := layout perform:fractSymb.
- offset := layout perform:offsetSymb.
- extent := (view superView computeExtent) perform:xOrY.
-
- aBool ifTrue:[
- offset := offset + ((fraction * extent) asInteger).
- (aspectHolders at:offsetSymb) value:offset.
- (aspectHolders at:fractSymb) value:0.
- ] ifFalse:[
- fraction := (fraction + (offset / extent)) asFloat.
-
- (fraction > 1.0) ifTrue:[ fraction := 1.0 ].
- (fraction < 0.0) ifTrue:[ fraction := 0.0 ].
-
- (aspectHolders at:offsetSymb) value:0.
- (aspectHolders at:fractSymb) value:fraction.
- ]
- ]
-!
-
-makeOffsetAll
- self makeOffsetLeft.
- self makeOffsetTop.
- self makeOffsetRight.
- self makeOffsetBottom.
-
-!
-
-makeOffsetBottom
- self makeLayout:'bottom' xOrY:#y offset:true.
-
-!
-
-makeOffsetLeft
- self makeLayout:'left' xOrY:#x offset:true.
-
-!
-
-makeOffsetRight
- self makeLayout:'right' xOrY:#x offset:true.
-
-!
-
-makeOffsetTop
- self makeLayout:'top' xOrY:#y offset:true.
-
-
-!
-
-makeRelativeAll
- self makeRelativeLeft.
- self makeRelativeTop.
- self makeRelativeRight.
- self makeRelativeBottom.
-
-!
-
-makeRelativeBottom
- self makeLayout:'bottom' xOrY:#y offset:false.
-
-!
-
-makeRelativeLeft
- self makeLayout:'left' xOrY:#x offset:false.
-
-!
-
-makeRelativeRight
- self makeLayout:'right' xOrY:#x offset:false.
-
-!
-
-makeRelativeTop
- self makeLayout:'top' xOrY:#y offset:false.
-
-! !
-
-!UIPainter methodsFor:'misc'!
-
-listOfOutletsFor:aViewClass
- "return a list of outlets for a view-class"
-
- |l1 l2 all rej|
-
- (aViewClass == Object) ifTrue:[^ nil].
-
- l1 := self listOfOutletsFor:(aViewClass superclass).
- l2 := self listOfOutletsForClass:aViewClass.
-
- l2 isNil ifTrue:[
- all := l1
- ] ifFalse:[
- l1 isNil ifTrue:[
- all := l2
- ] ifFalse:[
- all := l1 , l2
- ]
- ].
- rej := self rejectOutletsForClass:aViewClass.
- rej notNil ifTrue:[
- rej do:[:x |
- all := all copyWithout:x
- ]
- ].
- ^ all
-!
-
-listOfOutletsForClass:aViewClass
- "return a list of outlets for a view-class"
-
- "could this be done automatically ?"
-
- (aViewClass == Label) ifTrue:[
- ^ #('label'
- 'iconic-label'
- 'label layout'
- 'fixed size'
- 'foreground-color'
- 'background-color'
- )
- ].
- (aViewClass == Button) ifTrue:[
- ^ #(
- 'active foreground-color'
- 'active background-color'
- 'active level'
- 'passive level'
- 'press action'
- )
- ].
- (aViewClass == Toggle) ifTrue:[
- ^ #(
- 'release action'
- )
- ].
- (aViewClass == CheckBox) ifTrue:[
- ^ #(
- 'label'
- )
- ].
- (aViewClass == FramedBox) ifTrue:[
- ^ #(
- 'label'
- 'label position'
- 'frame shown'
- )
- ].
- (aViewClass == VerticalPanelView) ifTrue:[
- ^ #(
- 'horizontal layout'
- 'vertical layout'
- )
- ].
- (aViewClass == HorizontalPanelView) ifTrue:[
- ^ #(
- 'horizontal layout'
- 'vertical layout'
- )
- ].
- (aViewClass == VariableVerticalPanel) ifTrue:[
- ^ #(
- 'handle position'
- 'style'
- )
- ].
- (aViewClass == ListView) ifTrue:[
- ^ #(
- 'contents'
- )
- ].
- (aViewClass == SelectionInListView) ifTrue:[
- ^ #(
- 'press action'
- )
- ].
- (aViewClass == EditField) ifTrue:[
- ^#(
- 'initialText'
- 'field type'
- 'field length'
- )
- ].
- (aViewClass == View) ifTrue:[
- ^ #(
- 'level'
- 'view background-color'
- )
- ].
- (aViewClass == Scroller) ifTrue:[
- ^ #(
- 'scroll action'
- 'asynchronous'
- 'synchronous'
- )
- ].
- (aViewClass == ScrollBar) ifTrue:[
- ^ #(
- 'scroll action'
- 'scrollDown action'
- 'scrollUp action'
- 'asynchronous'
- 'synchronous'
- )
- ].
- (aViewClass == HorizontalScrollBar) ifTrue:[
- ^ #(
- 'scrollLeft action'
- 'scrollRight action'
- )
- ].
- (aViewClass == PullDownMenu) ifTrue:[
- ^ #(
- 'labels'
- 'actions'
- )
- ].
- (aViewClass == Separator) ifTrue:[
- ^ #(
- 'orientation'
- )
- ].
- ^ nil
-
- "Modified: 6.9.1995 / 13:42:09 / claus"
-!
-
-rejectOutletsForClass:aViewClass
- "return a list of suppressed outlets for a view-class"
-
- "could this be done automatically ?"
-
- (aViewClass == CheckToggle) ifTrue:[
- ^ #(
- 'iconic-label'
- )
- ].
- (aViewClass == CheckBox) ifTrue:[
- ^ #(
- 'horizontal layout'
- 'vertical layout'
- )
- ].
- (aViewClass == HorizontalScrollBar) ifTrue:[
- ^ #(
- 'scrollUp action'
- 'scrollDown action'
- )
- ].
- ^ nil
-
- "Modified: 4.9.1995 / 18:55:03 / claus"
-!
-
-setupPropertyFromSpec:aSpec
- "apply is pressed in the geometry-sub view, with a alignmentOrigin selected
- "
- |aViewsSpec|
-
- workView singleSelectionDo:[:selectedView |
- aViewsSpec := workView generateSpecFor:selectedView.
- aViewsSpec := aViewsSpec first.
- ].
-
- self setupPropertyFromSpec:aSpec for:aViewsSpec
-
-!
-
-setupPropertyFromSpec:aSpec for:aViewsSpec
- "setup menu from spec
- "
- |specBindings|
-
- outletView := nil.
-
- specShown ~= aSpec ifTrue:[
- propertyFrame destroySubViews.
-
- "/ get aspects from specClass
- specSpecificAspectHolders := IdentityDictionary new.
- aViewsSpec class addBindingsTo:specSpecificAspectHolders for:aViewsSpec channel:nil.
-
- builder buildFromSpec:aSpec in:propertyFrame.
- propertyFrame realizeAllSubViews.
- ].
- specShown := aSpec
-!
-
-showOutletsFor:aView
- |c outlets|
-
- outletView isNil ifTrue:[^ self].
-
- (aView isKindOf:SimpleView) ifFalse:[
- outletView list:nil.
- ^ self
- ].
- c := aView class.
-
- outlets := self listOfOutletsFor:c.
- outletView list:outlets
-
- "Modified: 5.9.1995 / 21:51:57 / claus"
-! !
-
-!UIPainter methodsFor:'private - fetch'!
-
-fetchColorsFrom:aView
- |holder|
-
- holder := self aspectFor:#foregroundColor.
- (aView respondsTo:#foregroundColor) ifTrue:[
- holder value:(aView foregroundColor storeString).
- ] ifFalse:[
- holder value:nil
- ].
- holder := self aspectFor:#backgroundColor.
- (aView respondsTo:#backgroundColor) ifTrue:[
- holder value:(aView backgroundColor storeString).
- ] ifFalse:[
- holder value:nil
- ].
-
-!
-
-fetchLayoutFrom:aView
- |layout extent|
-
- layout := aView geometryLayout.
- layout isNil ifTrue:[^ self].
-
- layout isLayout ifFalse:[
- layout isRectangle ifTrue:[
- (aspectHolders at:#leftOffset) value:(layout left).
- (aspectHolders at:#rightOffset) value:(layout right).
- (aspectHolders at:#topOffset) value:(layout top).
- (aspectHolders at:#bottomOffset) value:(layout bottom).
- ^ self
- ].
- layout isPoint ifTrue:[
- (aspectHolders at:#leftOffset) value:(layout left).
- (aspectHolders at:#rightOffset) value:(layout right).
- ^ self
- ].
- ].
-
- (aspectHolders at:#leftOffset) value:(layout leftOffset).
- (aspectHolders at:#leftFraction) value:(layout leftFraction).
- (aspectHolders at:#topOffset) value:(layout topOffset).
- (aspectHolders at:#topFraction) value:(layout topFraction).
-
- layout isLayoutFrame ifTrue:[
- (aspectHolders at:#rightOffset) value:(layout rightOffset).
- (aspectHolders at:#bottomOffset) value:(layout bottomOffset).
-
- (aspectHolders at:#rightFraction) value:(layout rightFraction).
- (aspectHolders at:#bottomFraction) value:(layout bottomFraction).
-
- (aspectHolders at:#leftAlignmentFraction) value:0.
- (aspectHolders at:#topAlignmentFraction) value:0.
- ] ifFalse:[
- extent := aView extent.
-
- (aspectHolders at:#rightOffset) value:(layout leftOffset + extent x).
- (aspectHolders at:#bottomOffset) value:(layout topOffset + extent y).
-
- (aspectHolders at:#rightFraction) value:0.
- (aspectHolders at:#bottomFraction) value:0.
-
- layout isAlignmentOrigin ifTrue:[
- (aspectHolders at:#leftAlignmentFraction) value:(layout leftAlignmentFraction).
- (aspectHolders at:#topAlignmentFraction) value:(layout topAlignmentFraction).
- ] ifFalse:[
- (aspectHolders at:#leftAlignmentFraction) value:0.
- (aspectHolders at:#topAlignmentFraction) value:0.
- ]
- ].
-
-
-!
-
-fetchModelAspectsFrom:aView
- (self aspectFor:#aspectChannel) value:(workView aspectSelectorForView:aView).
- (self aspectFor:#changeChannel) value:(workView changeSelectorForView:aView).
-
-! !
-
-!UIPainter methodsFor:'setup choices'!
-
-showAllWidgets
- "create list of basic widgets"
-
- self showWidgetsWhere:[:class | true]
-!
-
-showBasicWidgets
- "create list of basic widgets"
-
- self showWidgetsInCategory:'Views-Basic'
- butNot:[:class | class isKindOf:ModalBox class]
-!
-
-showInteractorWidgets
- "create list of interactor widgets"
-
- self showWidgetsInCategory:'Views-Interactors'
- butNot:[:class | class isKindOf:ModalBox class]
-!
-
-showLayoutWidgets
- "create list of basic widgets"
-
- self showWidgetsInCategory:'Views-Layout'
- butNot:[:class | class isKindOf:ModalBox class]
-!
-
-showModalWidgets
- "create list of modal widgets"
-
- self showWidgetsWhere:[:class | class isKindOf:ModalBox class]
-!
-
-showOtherWidgets
- "create list of other widgets"
-
- |check cat|
-
- check := [:class |
- (#('Views-Basic'
- 'Views-Interactors'
- 'Views-Layout'
- 'Views-Text') includes:class category) not].
- self showWidgetsWhere:check
- butNot:[:class | class isKindOf:ModalBox class]
-!
-
-showTextWidgets
- "create list of basic widgets"
-
- self showWidgetsInCategory:'Views-Text'
- butNot:[:class | class isKindOf:ModalBox class]
-!
-
-showWidgetsInCategory:aCategory
- "create list of basic widgets"
-
- self showWidgetsWhere:[:class | class category = aCategory]
-!
-
-showWidgetsInCategory:aCategory butNot:excludeBlock
- "create list of basic widgets"
-
- self showWidgetsWhere:[:class | class category = aCategory]
- butNot:excludeBlock
-!
-
-showWidgetsWhere:aBlock
- "create list of widgets where aBlock avaluates to true"
-
- self showWidgetsWhere:aBlock butNot:[:class | false]
-!
-
-showWidgetsWhere:aBlock butNot:excludeBlock
- "create list of widgets where aBlock evaluates to true and excludeBlock
- evaluates to false"
-
- |list|
-
- list := OrderedCollection new:0.
- SimpleView allSubclassesDo:[:aSubclass |
- (aBlock value:aSubclass) ifTrue:[
- (excludeBlock value:aSubclass) ifFalse:[
- list add:(aSubclass name)
- ]
- ]
- ].
- (aBlock value:View) ifTrue:[
- (excludeBlock value:View) ifFalse:[
- list add:'View'
- ]
- ].
- (list size == 0) ifFalse:[
- list sort
- ].
- elementMenu list:list
-! !
-
-!UIPainter methodsFor:'user actions - dimension'!
-
-setAlignmentOrigin
- "apply is pressed in the geometry-sub view, with a alignmentOrigin selected
- "
- self setupPropertyFromSpec:(self class geometrySpecForAlignmentOrigin)
-!
-
-setDimensionForAlignmentOrigin
- |view layout|
-
- view := workView singleSelection.
-
- view notNil ifTrue:[
- layout := AlignmentOrigin new.
-
- layout leftOffset:((aspectHolders at:#leftOffset) value) ? 0.
- layout topOffset:((aspectHolders at:#topOffset) value) ? 0.
- layout leftFraction:((aspectHolders at:#leftFraction) value) ? 0.
- layout topFraction:((aspectHolders at:#topFraction) value) ? 0.
-
- layout leftAlignmentFraction:((aspectHolders at:#leftAlignmentFraction) value) ? 0.
- layout topAlignmentFraction:((aspectHolders at:#topAlignmentFraction) value) ? 0.
-
- workView setDimension:layout.
- ]
-!
-
-setDimensionForLayoutFrame
- |view layout|
-
- view := workView singleSelection.
-
- view notNil ifTrue:[
- layout := LayoutFrame new.
-
- layout leftOffset:((aspectHolders at:#leftOffset) value) ? 0.
- layout rightOffset:((aspectHolders at:#rightOffset) value) ? 0.
- layout topOffset:((aspectHolders at:#topOffset) value) ? 0.
- layout bottomOffset:((aspectHolders at:#bottomOffset) value) ? 0.
- layout leftFraction:((aspectHolders at:#leftFraction) value) ? 0.
- layout rightFraction:((aspectHolders at:#rightFraction) value) ? 0.
- layout topFraction:((aspectHolders at:#topFraction) value) ? 0.
- layout bottomFraction:((aspectHolders at:#bottomFraction) value) ? 0.
-
- workView setDimension:layout.
- ]
-!
-
-setDimensionForLayoutOrigin
- |view layout|
-
- view := workView singleSelection.
-
- view notNil ifTrue:[
- layout := LayoutOrigin new.
-
- layout leftOffset:((aspectHolders at:#leftOffset) value) ? 0.
- layout topOffset:((aspectHolders at:#topOffset) value) ? 0.
-
- layout leftFraction:((aspectHolders at:#leftFraction) value) ? 0.
- layout topFraction:((aspectHolders at:#topFraction) value) ? 0.
-
- workView setDimension:layout.
- ]
-!
-
-setLayoutFrame
- "apply is pressed in the geometry-sub view, with a layoutFrame selected
- "
- self setupPropertyFromSpec:(self class geometrySpecForLayoutFrame)
-!
-
-setLayoutOrigin
- "apply is pressed in the geometry-sub view, with a layoutOrigin selected
- "
- self setupPropertyFromSpec:(self class geometrySpecForLayoutOrigin)
-! !
-
-!UIPainter methodsFor:'user interaction'!
-
-closeRequest
- workView notNil ifTrue:[workView release. workView := nil].
- super closeRequest
-!
-
-closeRequestFor:aTopView
- aTopView ~~ topView ifTrue:[
- topView device beep.
- ^ self
- ].
- super closeRequestFor:aTopView
-!
-
-selectOutlet:nr
- |outlet type sel text box action initialText initialList
- view prop t val|
-
- outlet := outletView selectionValue.
- outletView deselect.
- view := workView selection.
- view isNil ifTrue:[
- self notify:'select something first'.
- ^ self
- ].
- action := [:s | self setOutlet:sel type:type to:s in:view].
- (outlet = 'label') ifTrue:[
- type := #string.
- sel := #label:.
- text := 'label-text:'.
- initialText := view label
- ].
- (outlet = 'fixed size') ifTrue:[
- type := #boolean.
- sel := #sizeFixed:.
- text := 'size is fix:'.
- ].
- (outlet = 'frame shown') ifTrue:[
- type := #boolean.
- sel := #showFrame:.
- text := 'frame is to be drawn:'.
- ].
- (outlet = 'labels') ifTrue:[
- type := #strings.
- sel := #labels:.
- initialText := view labels
- ].
- (outlet = 'contents') ifTrue:[
- type := #text.
- sel := #contents:.
- initialText := view contents
- ].
- (outlet = 'initialText') ifTrue:[
- type := #string.
- sel := #initialText:.
- initialText := view contents
- ].
- (outlet = 'field type') ifTrue:[
- type := #fieldTypeSymbol.
- sel := #type:.
- initialList := #(number
- string
- password
- ).
- initialText := view converter isNil ifTrue:[#string] ifFalse:[view converter type].
- ].
- (outlet = 'field length') ifTrue:[
- type := #numberOrNil.
- sel := #maxChars:.
- text := 'field length (empty -> unlimited)'.
- initialText := view maxChars isNil ifTrue:[''] ifFalse:[view maxChars printString].
- ].
- (outlet = 'level') ifTrue:[
- type := #number.
- sel := #level:.
- initialText := view level printString
- ].
- (outlet = 'active level') ifTrue:[
- type := #number.
- sel := #onLevel:.
- initialText := view onLevel printString
- ].
- (outlet = 'passive level') ifTrue:[
- type := #number.
- sel := #offLevel:.
- initialText := view offLevel printString
- ].
- (outlet = 'iconic-label') ifTrue:[
- type := #form.
- sel := #label:.
- text := 'label-icon:'
- ].
- (outlet = 'view background-color') ifTrue:[
- type := #color.
- sel := #viewBackground:.
- text := 'view background color'.
- initialText := 'Black'
- ].
- (outlet = 'foreground-color') ifTrue:[
- type := #color.
- sel := #foregroundColor:.
- text := 'foreground color'.
- initialText := 'Black'
- ].
- (outlet = 'background-color') ifTrue:[
- type := #color.
- sel := #backgroundColor:.
- text := 'background color'.
- initialText := 'Grey'
- ].
- (outlet = 'active foreground-color') ifTrue:[
- type := #color.
- sel := #activeForegroundColor:.
- text := 'active foreground color'.
- initialText := 'Yellow'
- ].
- (outlet = 'active background-color') ifTrue:[
- type := #color.
- sel := #activeBackgroundColor:.
- text := 'active background color'.
- initialText := 'Grey'
- ].
- (outlet = 'scroll action') ifTrue:[
- type := #block.
- sel := #scrollAction:.
- text := 'action block when scrolled'
- ].
- (outlet = 'scrollUp action') ifTrue:[
- type := #block.
- sel := #scrollUpAction:.
- text := 'action block when scrolled up'
- ].
- (outlet = 'scrollDown action') ifTrue:[
- type := #block.
- sel := #scrollDownAction:.
- text := 'action block when scrolled down'
- ].
- (outlet = 'scrollLeft action') ifTrue:[
- type := #block.
- sel := #scrollLeftAction:.
- text := 'action block when scrolled left'
- ].
- (outlet = 'scrollRight action') ifTrue:[
- type := #block.
- sel := #scrollRightAction:.
- text := 'action block when scrolled right'
- ].
- (outlet = 'press action') ifTrue:[
- type := #block.
- sel := #pressAction:.
- text := 'action block when pressed'
- ].
- (outlet = 'release action') ifTrue:[
- type := #block.
- sel := #releaseAction:.
- text := 'action block when released'
- ].
- (outlet = 'style') ifTrue:[
- type := #symbol.
- sel := #style:.
- initialList := #(motif next)
- ].
- (outlet = 'handle position') ifTrue:[
- type := #symbol.
- sel := #handlePosition:.
- initialList := #(left center right)
- ].
- (outlet = 'horizontal layout') ifTrue:[
- type := #symbol.
- sel := #horizontalLayout:.
- text := 'horizontal components layout'.
- initialList := #(left
- leftSpace
- leftMax
- leftSpaceMax
- center
- centerMax
- right
- rightSpace
- rightMax
- rightSpaceMax
- spread
- spreadSpace
- spreadMax
- spreadSpaceMax
- fit
- fitSpace).
- initialText := view horizontalLayout printString
- ].
- (outlet = 'vertical layout') ifTrue:[
- type := #symbol.
- sel := #verticalLayout:.
- text := 'vertical components layout'.
- initialList := #(top
- topSpace
- center
- bottom
- bottomSpace
- spread
- spreadSpace
- fit
- fitSpace).
- initialText := view verticalLayout printString
- ].
- (outlet = 'label position') ifTrue:[
- type := #symbol.
- sel := #labelPosition:.
- initialList := #(topLeft topCenter topRight bottomLeft bottomCenter bottomRight).
- initialText := view labelPosition printString
- ].
- (outlet = 'label layout') ifTrue:[
- type := #symbol.
- sel := #adjust:.
- initialList := #( left right center centerLeft centerRight fit ).
- initialText := view adjust printString
- ].
- (outlet = 'orientation') ifTrue:[
- type := #symbol.
- sel := #orientation:.
- initialList := #( horizontal vertical ).
- initialText := view orientation printString
- ].
-
- (type == #color) ifTrue:[
- initialList := #('Black'
- 'White'
- 'LightGrey'
- 'Grey'
- 'DarkGrey'
- 'Yellow'
- 'Red'
- 'Green'
- 'Blue'
- )
- ].
-
- text isNil ifTrue:[
- text := outlet
- ].
-
- "what type of box do we need"
-
- t := type.
- ((type == #color) or:[type == #symbol or:[type == #fieldTypeSymbol]]) ifTrue:[
- t := #list
- ].
- ((type == #number) or:[type == #numberOrNil]) ifTrue:[
- t := #string
- ].
- (type == #strings) ifTrue:[
- t := #text
- ].
- (type == #block) ifTrue:[
- t := #text.
- initialText := workView outletValueOf:sel for:view.
- initialText isNil ifTrue:[initialText := '[statements]']
- ].
- (type == #block1) ifTrue:[
- t := #text.
- type := #block.
- initialText := workView outletValueOf:sel for:view.
- initialText isNil ifTrue:[initialText := '[:argument | statements ]']
- ].
- (type == #block2) ifTrue:[
- t := #text.
- type := #block.
- initialText := workView outletValueOf:sel for:view.
- initialText isNil ifTrue:[initialText := '[:arg1 :arg2 | statements ]']
- ].
-
- "show a box to enter thing"
-
- (t == #boolean) ifTrue:[
- val := Dialog confirmWithCancel:text.
- (val == true or:[val == false]) ifTrue:[
- action value:val
- ].
- ^ self
- ].
- (t == #string) ifTrue:[
-"/ stringBox isNil ifTrue:[
- stringBox := EnterBox new.
-"/ ].
- box := stringBox
- ].
- (t == #list) ifTrue:[
-"/ listBox isNil ifTrue:[
- listBox := ListSelectionBox new.
-"/ ].
- listBox list:initialList.
- box := listBox
- ].
- (t == #text) ifTrue:[
-"/ actionBox isNil ifTrue:[
- actionBox := TextBox new.
-"/ ].
- actionBox initialText:initialText.
- box := actionBox
- ].
-"
-Transcript show:'outlet: '. Transcript showCR:outlet.
-Transcript show:'type: '. Transcript showCR:type.
-Transcript show:'sel: '. Transcript showCR:sel.
-Transcript show:'text: '. Transcript showCR:text.
-"
-
- box isNil ifTrue:[
- self notify:'not yet implemented'
- ] ifFalse:[
- box initialText:initialText.
- box title:text.
- box action:action.
- box showAtPointer
- ]
-
- "Modified: 6.9.1995 / 13:46:29 / claus"
-!
-
-setColors
- |fg bg|
-
- fg := (self aspectFor:#foregroundColor) value.
-
- (fg notNil and:[fg notEmpty]) ifTrue:[
- fg := Color readFrom:fg.
- workView singleSelectionDo:[:selectedView |
- selectedView foregroundColor:fg
- ].
- ].
- bg := (self aspectFor:#backgroundColor) value.
-
- (bg notNil and:[bg notEmpty]) ifTrue:[
- bg := Color readFrom:bg.
- workView singleSelectionDo:[:selectedView |
- selectedView backgroundColor:bg
- ].
- ].
-!
-
-setMiscAspects
- "sent when apply is pressen in the misc-sub view"
-
- workView singleSelectionDo:[:selectedView |
- selectedView ~~ workView ifTrue:[
- workView changeVariableNameOf:selectedView to:nameChannel value
- ]
- ].
-!
-
-setModelAspects
- "sent when apply is pressen in the model-sub view"
-
- |aspectSymbol|
-
- aspectSymbol := (self aspectFor:#aspectChannel) value.
- (aspectSymbol notNil and:[aspectSymbol notEmpty]) ifTrue:[
- aspectSymbol := aspectSymbol asSymbol.
- workView singleSelectionDo:[:selectedView |
- selectedView ~~ workView ifTrue:[
- workView setAspectSelector:aspectSymbol forView:selectedView
- ].
- ].
- ].
-!
-
-setOutlet:outletSymbol type:type to:outletValue in:aView
- |block val messageSymbol|
-
- messageSymbol := outletSymbol.
- val := outletValue.
- (type == #block) ifTrue:[
- block := Compiler evaluate:val.
- (block == #Error) ifTrue:[
- self warn:'action will not work in test-mode'.
- workView addOutletDefinitionFor:outletSymbol
- type:type
- value:outletValue
- for:aView.
- ^ self
- ].
- val := block
- ].
- (type == #number) ifTrue:[
- val := Number readFromString:outletValue onError:0
- ].
- (type == #numberOrNil) ifTrue:[
- val := Number readFromString:outletValue onError:nil
- ].
- (type == #text) ifTrue:[
- val := outletValue asString
- ].
- (type == #strings) ifTrue:[
- val := outletValue asText
- ].
- (type == #symbol) ifTrue:[
- val := outletValue asSymbol.
- ].
- (type == #fieldTypeSymbol) ifTrue:[
- val := outletValue asSymbol.
- val == #password ifTrue:[
- aView passwordCharacter:$*
- ] ifFalse:[
- aView passwordCharacter:nil
- ].
- val := (PrintConverter new initFor:val).
- messageSymbol := #converter:
- ].
- (type == #color) ifTrue:[
- val := Color name:outletValue.
- val isNil ifTrue:[
- self warn:('no such color:' , outletValue).
- ^ self
- ]
- ].
-Transcript show:(val printString).
-Transcript showCR:('(' , val class printString , ')').
-
- workView selectionHiddenDo:[
- aView perform:messageSymbol with:val.
- workView elementChanged:aView.
- aView redraw.
- ].
- workView addOutletDefinitionFor:outletSymbol
- type:type
- value:outletValue
- for:aView
-
- "Modified: 6.9.1995 / 13:44:46 / claus"
-!
-
-showPropertyView
- |v l spec shown possibleProperties slices specIndex slice specSymbol|
-
- shown := whichProperty selection.
-
- workView singleSelectionDo:[:selectedView |
- |aViewsSpec|
-
- aViewsSpec := workView generateSpecFor:selectedView.
- aViewsSpec := aViewsSpec first.
-
- slices := selectedView specClass slices.
- possibleProperties := slices collect:[:slice | slice first asString].
- possibleProperties := possibleProperties, #('dimension' 'colors' 'model' 'misc' 'attribute list').
- possibleProperties ~= whichProperty list ifTrue:[
- whichProperty list:possibleProperties.
-
- (possibleProperties includes:shown) ifFalse:[
- shown := nil.
- ].
- ].
-
- specIndex := slices findFirst:[:slice | slice first = shown].
- specIndex ~~ 0 ifTrue:[
- slice := slices at:specIndex.
- specSymbol := slice at:2.
- (selectedView specClass respondsTo:specSymbol) ifTrue:[
- spec := selectedView specClass perform:specSymbol.
- ^ self setupPropertyFromSpec:spec for:aViewsSpec
- ]
- ].
-
- (shown = 'dimension' or:[shown = 'Position']) ifTrue:[
- (l := selectedView geometryLayout) notNil ifTrue:[
- l isLayout ifTrue:[
- l isAlignmentOrigin ifTrue:[
- spec := self class geometrySpecForAlignmentOrigin
- ] ifFalse:[
- l isLayoutFrame ifFalse:[
- spec := self class geometrySpecForLayoutOrigin
- ]
- ]
- ]
- ].
- spec isNil ifTrue:[
- spec := self class geometrySpecForLayoutFrame
- ].
- ^ self setupPropertyFromSpec:spec for:aViewsSpec
- ].
-
- shown = 'colors' ifTrue:[
- ^ self setupPropertyFromSpec:(self class colorSpec) for:aViewsSpec
- ].
-
- shown = 'model' ifTrue:[
- ^ self setupPropertyFromSpec:(self class modelSpec) for:aViewsSpec
- ].
-
- shown = 'misc' ifTrue:[
- ^ self setupPropertyFromSpec:(self class miscSpec) for:aViewsSpec
- ].
-
- shown = 'attribute list' ifTrue:[
- specShown ~~ #attributeList ifTrue:[
- propertyFrame destroySubViews.
- specSpecificAspectHolders := IdentityDictionary new.
-
- v := ScrollableView for:SelectionInListView in:propertyFrame.
- v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
- outletView := v scrolledView.
- outletView action:[:lineNr | lineNr notNil ifTrue:[self selectOutlet:lineNr]].
- propertyFrame realizeAllSubViews.
- specShown := #attributeList.
- ].
- self showOutletsFor:(workView selection).
- ^ self
- ].
- ].
-
- propertyFrame destroySubViews.
- outletView := nil.
- specShown := nil.
- specSpecificAspectHolders := IdentityDictionary new.
-
-! !
-
-!UIPainter methodsFor:'user interaction - dialogs'!
-
-checkClassAndSelector
- "check for class & superclass"
-
- |superclass cls|
-
- specClass isNil ifTrue:[^ false].
-
- specClass isBehavior ifFalse:[
- cls := Smalltalk at:specClass asSymbol
- ] ifTrue:[
- cls := specClass
- ].
- cls isNil ifTrue:[
- (superclass := Smalltalk at:specSuperclass asSymbol) isNil ifTrue:[
- self warn:'no class named ' , specSuperclass , ' exists.'.
- ^ false.
- ].
- (self confirm:'create ' , specClass , ' ?') ifTrue:[
- superclass subclass:(specClass asSymbol)
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'New-Applications'.
- ^ true.
- ].
- ^ false.
- ].
- cls isBehavior ifFalse:[
- self warn:'a global named ' , specClass , ' exists, but is no class.'.
- ^ false.
- ].
-
- specSuperclass isBehavior ifFalse:[
- superclass := Smalltalk at:specSuperclass asSymbol
- ] ifTrue:[
- superclass := specSuperclass
- ].
- specSuperclass notNil ifTrue:[
- superclass isNil ifTrue:[
- self warn:'no class named ' , specSuperclass , ' exists.'.
- ^ false.
- ].
-
- (cls isSubclassOf:superclass) ifFalse:[
- self warn:'a global named ' , specClass , ' exists, but is not a subclass of ' , superclass name , '.'.
- ^ false.
- ]
- ].
- ^ true
-!
-
-defineClassAndSelector
- "launch a dialog to define class, superclass and method"
-
- |again|
-
- [
- again := false.
- (self openDialogInterface:#nameAndSelectorSpec) ifTrue:[
-
- specClass := (self aspectFor:#classNameChannel) value.
- specSelector := (self aspectFor:#methodNameChannel) value.
- specSuperclass := (self aspectFor:#superclassNameChannel) value.
-
- again := self checkClassAndSelector not.
- again ifFalse:[
- workView className:specClass superclassName:specSuperclass selector:specSelector.
- ].
- ]
- ] doWhile:[again]
-
-! !
-
-!UIPainter methodsFor:'user interaction - menu'!
-
-doFinish
- self closeRequest
-!
-
-doFromClass
- |className methodName cls sel accepted failed spec s|
-
- className := '' asValue.
- methodName := '' asValue.
- (s := workView className) notNil ifTrue:[
- className value:s
- ].
- (s := workView methodName) notNil ifTrue:[
- methodName value:s
- ].
-
- failed := false.
- [
- accepted :=
- (DialogBox new
- addTextLabel:'Classes name:';
- addInputFieldOn:className;
- addVerticalSpace;
- addTextLabel:'methods name:';
- addInputFieldOn:methodName;
- addAbortButton;
- addOkButton;
- open
- ) accepted.
-
- accepted ifTrue:[
- cls := Smalltalk classNamed:className value.
- cls isNil ifTrue:[
- failed := true.
- self warn:'no such class'.
- ] ifFalse:[
- sel := methodName value asSymbol.
- (cls respondsTo:sel ) ifFalse:[
- failed := true.
- self warn:'no such method'
- ] ifTrue:[
- spec := cls perform:sel.
- spec isArray ifFalse:[
- failed := true.
- self warn:'not a windowSpec method'
- ].
- "/ ok, got it
- workView className:className value.
- workView methodName:methodName value.
- workView setupFromSpec:spec.
- ^ self
- ]
- ]
- ]
- ] doWhile:[accepted and:[failed]].
-
- "Modified: 5.9.1995 / 18:47:57 / claus"
-!
-
-doInstall
- |code|
-
- (specClass isNil or:[specSelector isNil]) ifTrue:[
- self defineClassAndSelector
- ].
-
- self checkClassAndSelector ifFalse:[
- ^ self
- ].
-
- workView className:specClass superclassName:specSuperclass selector:specSelector.
-
- code := workView generateCode.
- (ReadStream on:code) fileIn.
-
- "Modified: 4.9.1995 / 17:06:10 / claus"
-!
-
-doNew
- workView removeAll.
- ^ self
-
- "Modified: 5.9.1995 / 20:52:21 / claus"
-!
-
-doOpen
- fileBox isNil ifTrue:[
- fileBox := FileSelectionBox
- title:''
- "pattern:'*.sib'"
- okText:''
- abortText:(Resource name:'BUILDER_ABORT_LABEL'
- fromFile:'Builder.rs')
- action:[nil]
- ].
- fileBox title:(Resource name:'BUILDER_OPEN_TITLE' fromFile:'Builder.rs').
- fileBox action:[:fileName | self openFile:fileName].
- fileBox okText:(Resource name:'BUILDER_OPEN_OK_LABEL' fromFile:'Builder.rs').
- fileBox showAtPointer
-!
-
-doPickAView
- |view className methodName cls sel accepted spec s|
-
- view := Display viewFromUser.
- view isNil ifTrue:[^ self].
-
- spec := UISpecification fromView:view topView.
- self halt.
-
- "/ ok, got it
- workView setupFromSpec:spec.
- workView className:view class name.
- workView methodName:#newSpec.
- ^ self
-
- "Modified: 5.9.1995 / 23:25:53 / claus"
-!
-
-doPrint
- ^ self
-!
-
-doSave
- currentFileName notNil ifTrue:[
- self saveAs:currentFileName
- ] ifFalse:[
- self doSaveAs
- ]
-!
-
-doSaveAs
- fileBox isNil ifTrue:[
- fileBox := FileSelectionBox
- title:''
- "pattern:'*.draw'"
- okText:''
- abortText:(Resource name:'BUILDER_ABORT_LABEL'
- fromFile:'Builder.rs')
- action:[nil]
- ].
- fileBox title:(Resource name:'BUILDER_SAVE_TITLE' fromFile:'Builder.rs').
- fileBox action:[:fileName | self saveAs:fileName].
- fileBox okText:(Resource name:'BUILDER_SAVE_OK_LABEL' fromFile:'Builder.rs').
- fileBox showAtPointer
-! !
-
-!UIPainter ignoredMethodsFor:'user interaction - menu'!
-
-doSource
- |code v|
-
- code := workView generateCode.
- v := CodeView open.
- v contents:code.
- v label:(workView applicationName).
- ^ self
-
- "Modified: 5.9.1995 / 21:02:05 / claus"
-! !
-
-!UIPainter methodsFor:'user interaction - menu'!
-
-doWindowSpec
- |code v|
-
- code := workView generateWindowSpecMethodSource.
- v := CodeView open.
- v contents:code.
- v label:'windowSpec'.
- ^ self
-
- "Modified: 5.9.1995 / 21:04:14 / claus"
-!
-
-toggleTest
- |m t|
-
- m := menu menuAt:#test.
- t := workView testMode not.
-
- t ifTrue:[
- m labelAt:#toggleTest put:(resources string:'test off')
- ] ifFalse:[
- m labelAt:#toggleTest put:(resources string:'test on')
- ].
- workView testMode:t
-! !
-
!UIPainter::ButtonPanel methodsFor:'accessing'!
receiver
@@ -2984,8 +114,3 @@
^ menu
! !
-!UIPainter class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-! !
--- 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$'
-! !
--- a/UIPropertyView.st Fri Feb 21 20:33:57 1997 +0100
+++ b/UIPropertyView.st Tue Feb 25 14:15:56 1997 +0100
@@ -1,7 +1,7 @@
ApplicationModel subclass:#UIPropertyView
- instanceVariableNames:'receiver modified propertyFrame propertyList propertySpecs
- currentView currentSpec aspects specBeingEdited
- userSelectedProperty'
+ instanceVariableNames:'builderView modified propertyFrame propertyList propertySpecs
+ currentView currentSpec propertyAspects staticAspects
+ specBeingEdited userSelectedProperty currentSpecChannel'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
@@ -18,6 +18,12 @@
^ application
! !
+!UIPropertyView class methodsFor:'constants'!
+
+titleOfLayoutMenu
+ ^ 'Dimension'
+! !
+
!UIPropertyView class methodsFor:'specifications'!
specificationAlignmentOrigin
@@ -74,7 +80,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 57 0 42 0 114 0 60 0)
#'model:' #leftFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -82,7 +90,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 57 0 69 0 114 0 87 0)
#'model:' #topFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -90,7 +100,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 57 0 96 0 114 0 114 0)
#'model:' #leftAlignmentFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -98,7 +110,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 56 0 122 0 113 0 140 0)
#'model:' #topAlignmentFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -106,7 +120,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 154 0 42 0 212 0 60 0)
#'model:' #leftOffset
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -114,7 +130,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 154 0 69 0 212 0 87 0)
#'model:' #topOffset
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#ActionButtonSpec
@@ -147,19 +165,19 @@
#'name:' 'button'
#'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
#'label:' 'frame'
- #'model:' #setLayoutFrame
+ #'model:' #showLayoutFrame
)
#(#ActionButtonSpec
#'name:' 'button'
#'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
#'label:' 'origin'
- #'model:' #setLayoutOrigin
+ #'model:' #showLayoutOrigin
)
#(#ActionButtonSpec
#'name:' 'button'
#'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
#'label:' 'align'
- #'model:' #setAlignmentOrigin
+ #'model:' #showAlignmentOrigin
#'initiallyDisabled:' true
)
@@ -236,10 +254,8 @@
#'model:' #leftFraction
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'relative E2'
@@ -247,10 +263,8 @@
#'model:' #topFraction
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'relative E3'
@@ -258,10 +272,8 @@
#'model:' #rightFraction
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'relative E4'
@@ -269,10 +281,8 @@
#'model:' #bottomFraction
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'offset E1'
@@ -280,10 +290,8 @@
#'model:' #leftOffset
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'offset E2'
@@ -291,10 +299,8 @@
#'model:' #topOffset
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'offset E3'
@@ -302,10 +308,8 @@
#'model:' #rightOffset
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#InputFieldSpec
#'name:' 'offset E4'
@@ -313,10 +317,8 @@
#'model:' #bottomOffset
#'type:' #numberOrNil
#'immediateAccept:' false
- #'acceptOnLeave:' true
#'acceptOnReturn:' true
#'acceptOnTab:' true
- #'acceptOnLostFocus:' true
)
#(#ActionButtonSpec
#'name:' 'relative B1'
@@ -382,19 +384,20 @@
#'name:' 'button'
#'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
#'label:' 'frame'
- #'model:' #setLayoutFrame
+ #'model:' #showLayoutFrame
+ #'initiallyDisabled:' true
)
#(#ActionButtonSpec
#'name:' 'button10'
#'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
#'label:' 'origin'
- #'model:' #setLayoutOrigin
+ #'model:' #showLayoutOrigin
)
#(#ActionButtonSpec
#'name:' 'button11'
#'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
#'label:' 'align'
- #'model:' #setAlignmentOrigin
+ #'model:' #showAlignmentOrigin
)
)
@@ -449,7 +452,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 57 0 42 0 114 0 60 0)
#'model:' #leftFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -457,7 +462,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 57 0 69 0 114 0 87 0)
#'model:' #topFraction
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -465,7 +472,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 154 0 42 0 212 0 60 0)
#'model:' #leftOffset
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#InputFieldSpec
@@ -473,7 +482,9 @@
#'type:' #numberOrNil
#'layout:' #(#LayoutFrame 154 0 69 0 212 0 87 0)
#'model:' #topOffset
- #acceptOnLostFocus: true
+ #'immediateAccept:' false
+ #'acceptOnReturn:' true
+ #'acceptOnTab:' true
#tabable: true
)
#(#ActionButtonSpec
@@ -506,20 +517,20 @@
#'name:' 'button'
#'layout:' #(#LayoutFrame 16 0 210 0 76 0 240 0)
#'label:' 'frame'
- #'model:' #setLayoutFrame
+ #'model:' #showLayoutFrame
)
#(#ActionButtonSpec
#'name:' 'button'
#'layout:' #(#LayoutFrame 96 0 210 0 156 0 240 0)
#'label:' 'origin'
- #'model:' #setLayoutOrigin
+ #'model:' #showLayoutOrigin
#'initiallyDisabled:' true
)
#(#ActionButtonSpec
#'name:' 'button'
#'layout:' #(#LayoutFrame 176 0 210 0 236 0 240 0)
#'label:' 'align'
- #'model:' #setAlignmentOrigin
+ #'model:' #showAlignmentOrigin
)
)
@@ -532,11 +543,70 @@
!UIPropertyView methodsFor:'accessing'!
-modified
- "returns state of modification flag
- "
- ^ modified
-!
+update:something
+ |slices list view prevSpecClass|
+
+ (something == #selection or:[something == #tree]) ifFalse:[
+ (something == #layout and:[modified not and:[self isLayoutSpec]]) ifTrue:[
+ self layoutRead.
+ ].
+ ^ self
+ ].
+
+ view := builderView singleSelection.
+
+ propertyAspects := nil.
+ currentView := view.
+ self modified:false.
+
+
+ currentView isNil ifTrue:[
+ "/ the workView itself.
+
+ propertyList selectionIndex:nil.
+ currentSpecChannel := nil.
+
+ propertyList list:#().
+ propertySpecs := nil.
+
+ "/ must setup for a WindowSpec (to allow entry of min- maxSize etc).
+"/ propertyList list:#('Basics' 'Detail').
+ ^ self
+ ].
+
+ prevSpecClass := specBeingEdited class.
+
+ specBeingEdited := (builderView generateSpecFor:currentView) first.
+
+ (specBeingEdited class ~~ prevSpecClass
+ or:[currentSpecChannel isNil]) ifTrue:[
+ propertyList selectionIndex:nil.
+ propertyAspects := IdentityDictionary new.
+ propertySpecs := OrderedCollection new.
+ slices := currentView specClass slices.
+
+ list := slices collect:[:slice|
+ propertySpecs add:(slice last).
+ slice first asString
+ ].
+
+ list := list, (Array with:(self class titleOfLayoutMenu)).
+
+ currentSpecChannel := specBeingEdited asValue.
+ specBeingEdited class addBindingsTo:propertyAspects
+ for:specBeingEdited
+ channel:currentSpecChannel.
+ propertyAspects do:[:anAspect | anAspect addDependent:self ].
+ propertyList list:list.
+ propertyList selection:userSelectedProperty.
+ ] ifFalse:[
+ currentSpecChannel value:specBeingEdited
+ ]
+
+
+! !
+
+!UIPropertyView methodsFor:'change & update'!
modified:aState
"change state of modification flag
@@ -552,86 +622,6 @@
]
!
-setupView:aView
-
- |slices list|
-
- currentView == aView ifTrue:[
- ^ self
- ].
-
- aspects := nil.
- currentView := aView.
-
- propertyList selectionIndex:nil.
-
- currentView isNil ifTrue:[
- propertyList list:#().
- propertySpecs := nil.
- aspects := nil.
- self modified:false.
- ^ self
- ].
-
- aspects := IdentityDictionary new.
-
- #( bottomFraction bottomOffset
- leftFraction leftOffset
- topFraction topOffset
- rightFraction rightOffset
- leftAlignmentFraction topAlignmentFraction
- )
- do:[:aChannel|
- aspects at:aChannel put:(ValueHolder new)
- ].
-
- specBeingEdited := (receiver generateSpecFor:currentView) first.
-
- propertySpecs := OrderedCollection new.
- slices := currentView specClass slices.
-
- list := slices collect:[:slice|
- propertySpecs add:(slice last).
- slice first asString
- ].
-
- list := list, #( 'Dimension' ).
-
- specBeingEdited class addBindingsTo:aspects
- for:specBeingEdited
- channel:nil.
-
- aspects do:[:anAspect | anAspect addDependent:self ].
-
- propertyList list:list.
- propertyList selection:userSelectedProperty.
-
-! !
-
-!UIPropertyView methodsFor:'button actions'!
-
-apply
- self modified ifTrue:[
- receiver updateFromSpec:specBeingEdited.
- self modified:false.
- ]
-!
-
-cancel
- |view|
-
- self modified ifTrue:[
- self modified:false.
-
- (view := currentView) notNil ifTrue:[
- currentView := nil.
- self setupView:view
- ].
- ]
-! !
-
-!UIPropertyView methodsFor:'change & update'!
-
propertySelectionChanged
"called when the property selection changed
"
@@ -640,37 +630,38 @@
sel := propertyList selection.
(currentView isNil or:[sel isNil]) ifTrue:[
+ "/ must setup for a WindowSpec for workView (to allow entry of min- maxSize etc).
+"/ currentView isNil ifTrue:[
+"/ currentView := receiver
+"/ ].
^ self showSpec:nil
].
index := propertyList selectionIndex.
userSelectedProperty := sel.
index > propertySpecs size ifTrue:[ "/ one of my specifications
- sel = 'Dimension' ifTrue:[
+ (sel == self class titleOfLayoutMenu) ifTrue:[
spec := self specificationLayout
]
] ifFalse:[
spec := currentView specClass perform:(propertySpecs at:index).
].
self showSpec:spec.
- self modified:false.
-
!
update:something with:aParameter from:changedObject
- self modified ifFalse:[
- self modified:true
- ]
+ self modified:true
! !
!UIPropertyView methodsFor:'initialization'!
-in:aTopView receiver:aReceiver
+in:aTopView receiver:aBuilderView
|menu y cancelButton applyButton panel|
super initialize.
+ self initializeStaticAspects.
- receiver := aReceiver.
+ builderView := aBuilderView.
menu := PopUpList label:'properties' in:aTopView.
menu defaultLabel:'properties'.
@@ -682,7 +673,8 @@
propertyList := SelectionInList new.
propertyList list:#( ).
- propertyList selectionIndexHolder onChangeSend:#propertySelectionChanged to:self.
+ propertyList selectionIndexHolder onChangeSend:#propertySelectionChanged
+ to:self.
menu model:propertyList.
y := menu preferredExtent y.
@@ -698,17 +690,43 @@
builder componentAt:#applyButton put:applyButton.
cancelButton action:[ self cancel ].
- applyButton action:[ self apply ].
+ applyButton action:[ self apply ].
modified := true.
self modified:false.
+!
+
+initializeStaticAspects
+
+ staticAspects := IdentityDictionary new.
+
+ #( bottomFraction bottomOffset
+ leftFraction leftOffset
+ topFraction topOffset
+ rightFraction rightOffset
+ leftAlignmentFraction topAlignmentFraction
+ )
+ do:[:aChannel|
+ staticAspects at:aChannel put:(ValueHolder new).
+ ].
+
+ staticAspects do:[:anAspect | anAspect addDependent:self ].
+
! !
!UIPropertyView methodsFor:'private'!
aspectFor:aKey
+ |aspect|
- ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ].
+ propertyAspects notNil ifTrue:[
+ aspect := propertyAspects at:aKey ifAbsent:nil.
+ aspect notNil ifTrue:[
+ ^ aspect
+ ]
+ ].
+
+ ^ staticAspects at:aKey ifAbsent:[super aspectFor:aKey]
!
showSpec:aSpec
@@ -723,77 +741,158 @@
]
].
currentSpec := aSpec.
+ self modified:false.
+! !
+
+!UIPropertyView methodsFor:'private actions'!
+
+apply
+ modified ifTrue:[
+ self modified:false.
+
+ self isLayoutSpec ifFalse:[
+ builderView updateFromSpec:specBeingEdited
+ ] ifTrue:[
+ self layoutWrite
+ ]
+ ]
+
+!
+
+cancel
+ |view|
+
+ modified ifTrue:[
+ self modified:false.
+
+ self isLayoutSpec ifFalse:[
+ currentView := nil.
+ self update:#selection
+ ] ifTrue:[
+ self layoutRead
+ ]
+ ]
+
! !
!UIPropertyView methodsFor:'private layout'!
-fetchLayout
+layoutRead
|layout extent|
layout := currentView geometryLayout.
layout isNil ifTrue:[^ self].
+ modified := true. "supress event notifications"
layout isLayout ifFalse:[
- layout isRectangle ifTrue:[
- (aspects at:#leftOffset) value:(layout left).
- (aspects at:#rightOffset) value:(layout right).
- (aspects at:#topOffset) value:(layout top).
- (aspects at:#bottomOffset) value:(layout bottom).
+ (layout isRectangle or:[layout isPoint]) ifTrue:[
+ (staticAspects at:#leftOffset) value:(layout left).
+ (staticAspects at:#rightOffset) value:(layout right).
+
+ layout isRectangle ifTrue:[
+ (staticAspects at:#topOffset) value:(layout top).
+ (staticAspects at:#bottomOffset) value:(layout bottom).
+ ].
+ modified := false.
^ self
- ].
- layout isPoint ifTrue:[
- (aspects at:#leftOffset) value:(layout left).
- (aspects at:#rightOffset) value:(layout right).
- ^ self
- ].
+ ]
].
- (aspects at:#leftOffset) value:(layout leftOffset).
- (aspects at:#leftFraction) value:(layout leftFraction).
- (aspects at:#topOffset) value:(layout topOffset).
- (aspects at:#topFraction) value:(layout topFraction).
+ (staticAspects at:#leftOffset) value:(layout leftOffset).
+ (staticAspects at:#leftFraction) value:(layout leftFraction).
+ (staticAspects at:#topOffset) value:(layout topOffset).
+ (staticAspects at:#topFraction) value:(layout topFraction).
layout isLayoutFrame ifTrue:[
- (aspects at:#rightOffset) value:(layout rightOffset).
- (aspects at:#bottomOffset) value:(layout bottomOffset).
+ (staticAspects at:#rightOffset) value:(layout rightOffset).
+ (staticAspects at:#bottomOffset) value:(layout bottomOffset).
- (aspects at:#rightFraction) value:(layout rightFraction).
- (aspects at:#bottomFraction) value:(layout bottomFraction).
+ (staticAspects at:#rightFraction) value:(layout rightFraction).
+ (staticAspects at:#bottomFraction) value:(layout bottomFraction).
- (aspects at:#leftAlignmentFraction) value:0.
- (aspects at:#topAlignmentFraction) value:0.
+ (staticAspects at:#leftAlignmentFraction) value:0.
+ (staticAspects at:#topAlignmentFraction) value:0.
] ifFalse:[
extent := currentView extent.
- (aspects at:#rightOffset) value:(layout leftOffset + extent x).
- (aspects at:#bottomOffset) value:(layout topOffset + extent y).
+ (staticAspects at:#rightOffset) value:(layout leftOffset + extent x).
+ (staticAspects at:#bottomOffset) value:(layout topOffset + extent y).
- (aspects at:#rightFraction) value:0.
- (aspects at:#bottomFraction) value:0.
+ (staticAspects at:#rightFraction) value:0.
+ (staticAspects at:#bottomFraction) value:0.
layout isAlignmentOrigin ifTrue:[
- (aspects at:#leftAlignmentFraction) value:(layout leftAlignmentFraction).
- (aspects at:#topAlignmentFraction) value:(layout topAlignmentFraction).
+ (staticAspects at:#leftAlignmentFraction) value:(layout leftAlignmentFraction).
+ (staticAspects at:#topAlignmentFraction) value:(layout topAlignmentFraction).
] ifFalse:[
- (aspects at:#leftAlignmentFraction) value:0.
- (aspects at:#topAlignmentFraction) value:0.
+ (staticAspects at:#leftAlignmentFraction) value:0.
+ (staticAspects at:#topAlignmentFraction) value:0.
]
].
-!
-
-setAlignmentOrigin
- self showSpec:(self class specificationAlignmentOrigin).
+ modified := false.
!
-setLayoutFrame
- self showSpec:(self class specificationLayoutFrame).
+layoutWrite
+ |layout|
+
+ currentView isNil ifTrue:[
+ ^ self
+ ].
+
+ (currentSpec == self class specificationLayoutFrame) ifTrue:[
+ layout := LayoutFrame new.
+
+ layout leftOffset:((staticAspects at:#leftOffset) value) ? 0.
+ layout rightOffset:((staticAspects at:#rightOffset) value) ? 0.
+ layout topOffset:((staticAspects at:#topOffset) value) ? 0.
+ layout bottomOffset:((staticAspects at:#bottomOffset) value) ? 0.
+ layout leftFraction:((staticAspects at:#leftFraction) value) ? 0.
+ layout rightFraction:((staticAspects at:#rightFraction) value) ? 0.
+ layout topFraction:((staticAspects at:#topFraction) value) ? 0.
+ layout bottomFraction:((staticAspects at:#bottomFraction) value) ? 0.
+
+ builderView setDimension:layout
+ ].
+
+ (currentSpec == self class specificationAlignmentOrigin) ifTrue:[
+ layout := AlignmentOrigin new.
+
+ layout leftOffset:((staticAspects at:#leftOffset) value) ? 0.
+ layout topOffset:((staticAspects at:#topOffset) value) ? 0.
+ layout leftFraction:((staticAspects at:#leftFraction) value) ? 0.
+ layout topFraction:((staticAspects at:#topFraction) value) ? 0.
+
+ layout leftAlignmentFraction:((staticAspects at:#leftAlignmentFraction) value) ? 0.
+ layout topAlignmentFraction:((staticAspects at:#topAlignmentFraction) value) ? 0.
+
+ ^ builderView setDimension:layout.
+ ].
+
+ (currentSpec == self class specificationLayoutOrigin) ifTrue:[
+ layout := LayoutOrigin new.
+
+ layout leftOffset:((staticAspects at:#leftOffset) value) ? 0.
+ layout topOffset:((staticAspects at:#topOffset) value) ? 0.
+ layout leftFraction:((staticAspects at:#leftFraction) value) ? 0.
+ layout topFraction:((staticAspects at:#topFraction) value) ? 0.
+
+ builderView setDimension:layout.
+ ].
+
!
-setLayoutOrigin
- self showSpec:(self class specificationLayoutOrigin).
+showAlignmentOrigin
+ self switchLayoutSpec:(self class specificationAlignmentOrigin)
+!
+showLayoutFrame
+ self switchLayoutSpec:(self class specificationLayoutFrame)
+!
+
+showLayoutOrigin
+ self switchLayoutSpec:(self class specificationLayoutOrigin)
!
specificationLayout
@@ -821,8 +920,17 @@
]
].
- spec notNil ifTrue:[ self fetchLayout].
+ spec notNil ifTrue:[
+ self layoutRead
+ ].
^ spec
+!
+
+switchLayoutSpec:aSpecification
+ self layoutRead.
+ self showSpec:aSpecification.
+ self modified:true.
+
! !
!UIPropertyView methodsFor:'private make layout'!
@@ -851,16 +959,16 @@
aBool ifTrue:[
offset := offset + ((fraction * extent) asInteger).
- (aspects at:offsetSymb) value:offset.
- (aspects at:fractSymb) value:0.
+ (staticAspects at:offsetSymb) value:offset.
+ (staticAspects at:fractSymb) value:0.
] ifFalse:[
fraction := (fraction + (offset / extent)) asFloat.
(fraction > 1.0) ifTrue:[ fraction := 1.0 ].
(fraction < 0.0) ifTrue:[ fraction := 0.0 ].
- (aspects at:offsetSymb) value:0.
- (aspects at:fractSymb) value:fraction.
+ (staticAspects at:offsetSymb) value:0.
+ (staticAspects at:fractSymb) value:fraction.
]
]
@@ -923,6 +1031,14 @@
! !
+!UIPropertyView methodsFor:'queries'!
+
+isLayoutSpec
+ "returns true if current menu is layout
+ "
+ ^ propertyList selection == self class titleOfLayoutMenu
+! !
+
!UIPropertyView class methodsFor:'documentation'!
version