# HG changeset patch # User ca # Date 856876556 -3600 # Node ID 0a2b2ff030a090c930842e55713c14ec7490d5da # Parent 668eb9eae2ac0e3530156b774386637303f069cb so far ... diff -r 668eb9eae2ac -r 0a2b2ff030a0 UIObjectView.st --- 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 - - - 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$' -! ! diff -r 668eb9eae2ac -r 0a2b2ff030a0 UIPainter.st --- 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" - - - - ^ - - #(#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 - " - - - - ^ - - #(#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" - - - ^ - - #(#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 - " - - - ^ - - #(#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 - " - - - ^ - - #(#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 - " - - - ^ - - #(#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" - - - - ^ - - #(#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" - - - - ^ - - #(#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" - - - - ^ - - #(#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" - - - - ^ - - #(#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$' -! ! diff -r 668eb9eae2ac -r 0a2b2ff030a0 UIPainterView.st --- a/UIPainterView.st Fri Feb 21 20:33:57 1997 +0100 +++ b/UIPainterView.st Tue Feb 25 14:15:56 1997 +0100 @@ -1,1731 +1,12 @@ -" - COPYRIGHT (c) 1995 by Claus Gittinger - All Rights Reserved - - This software is furnished under a license and may be used - only in accordance with the terms of that license and with the - inclusion of the above copyright notice. This software may not - be provided or otherwise made available to, or used by, any - other person. No title to or ownership of the software is - hereby transferred. -" - -UIObjectView subclass:#UIPainterView - instanceVariableNames:'fontPanel viewProperties superclassName className methodName - categoryName' - classVariableNames:'HandCursor' - poolDictionaries:'' - category:'Interface-UIPainter' -! - Object subclass:#ViewProperty instanceVariableNames:'aspectSelector changeSelector nameIndex view elementClass - labelSelector identifier tabable' + labelSelector identifier tabable defaultable menuSelector + initiallyInvisible' classVariableNames:'Identifier' poolDictionaries:'' privateIn:UIPainterView ! -UIPainterView::ViewProperty subclass:#GroupProperties - instanceVariableNames:'controlledObjects group' - classVariableNames:'' - poolDictionaries:'' - privateIn:UIPainterView -! - -!UIPainterView class methodsFor:'documentation'! - -copyright -" - COPYRIGHT (c) 1995 by Claus Gittinger - All Rights Reserved - - This software is furnished under a license and may be used - only in accordance with the terms of that license and with the - inclusion of the above copyright notice. This software may not - be provided or otherwise made available to, or used by, any - other person. No title to or ownership of the software is - hereby transferred. -" -! - -documentation -" - not yet finished, not yet published, not yet released. -" -! ! - -!UIPainterView class methodsFor:'defaults'! - -defaultMenuMessage - "This message is the default yo be sent to the menuHolder to get a menu - " - ^ #menu - - -! ! - -!UIPainterView methodsFor:'accessing'! - -application - self halt. - ^ nil - - "Modified: 6.9.1995 / 00:46:44 / claus" -! - -className - ^ className - - "Modified: 5.9.1995 / 18:41:30 / claus" -! - -className:aString - className := aString - - "Modified: 5.9.1995 / 18:47:17 / claus" -! - -className:aClassName superclassName:aSuperclassName selector:aSelector - className := aClassName. - superclassName := aSuperclassName. - methodName := aSelector. - -! - -methodName - ^ methodName - - "Modified: 5.9.1995 / 18:41:34 / claus" -! - -methodName:aString - methodName := aString - - "Modified: 5.9.1995 / 18:47:27 / claus" -! - -selectNames:aStringOrCollection - |prop coll s| - - (aStringOrCollection isNil or:[aStringOrCollection isEmpty]) ifTrue:[ - ^ self unselect - ]. - - (s := aStringOrCollection) isString ifFalse:[ - s size == 1 ifTrue:[ - s := s first - ] ifFalse:[ - coll := OrderedCollection new. - - s do:[:aName| - (prop := self propertyOfName:aName) notNil ifTrue:[ - coll add:(prop view) - ] - ]. - coll size == 1 ifTrue:[ ^ self select:(coll at:1) ]. - coll size == 0 ifTrue:[ ^ self unselect ]. - - ^ self select:coll. - ] - ]. - - prop := self propertyOfName:s. - prop isNil ifTrue:[^ self unselect] - ifFalse:[^ self select:(prop view)] - -! ! - -!UIPainterView ignoredMethodsFor:'code manipulation'! - -changeClass - |box classNameHolder superclassNameHolder| - - classNameHolder := (className ? 'MyClass') asValue. - superclassNameHolder := (superclassName ? 'ApplicationModel') asValue. - - box := DialogBox new. - box addTextLabel:'class:'. - box addInputFieldOn:classNameHolder. - box addTextLabel:'super class:'. - box addInputFieldOn:superclassNameHolder. - box addAbortButton; addOkButton. - - box open. - - box accepted ifTrue:[ - className := classNameHolder value. - superclassName := superclassNameHolder value. - ]. - - - - - - -! - -changeVariables - | box names propList p n newName| - - names := VariableArray new. - propList := VariableArray new. - viewProperties do:[:props | - n := props name. - n notNil ifTrue:[ - names add:n. - propList add:props - ] - ]. - box := BuilderVariablesBox new. - box list:names. - box selectAction:[:selection | - p := propList at:selection - ]. - box okAction:[ - newName := box enterValue. -Transcript showCR:('renamed ' , (p name) , 'to:' , newName). - p name:newName - ]. - box showAtPointer - - - -! ! - -!UIPainterView methodsFor:'creating subviews'! - -addProperties:properties for:aView - "set properties to a view and add properties to viewProperties. - In case that properties are nil properties are created - " - |name props| - - (props := properties) isNil ifTrue:[ - props := self propertiesForNewView:aView. - ]. - - viewProperties add:props. - name := props name. - - (aView respondsTo:#label:) ifTrue:[ - aView label:name - ]. - aView name:name. - ^ props -! - -propertiesForNewView:aView - |cls props index| - - cls := aView class. - - props := ViewProperty new. - props view:aView. - props elementClass:cls. - index := self variableIndexForClass:cls. - props nameIndex:index. - props name:(self variableNameForClass:cls index:index). - -"/ props initCode:nil. --- add user-defined init code later - - ^ props -! - -setupCreatedObject:anObject - "set default properties for a created object - " - |props| - - props := self addProperties:nil for:anObject. - - undoHistory transaction:#create text:(props name) do:[ - self undoCreate:(props identifier). - ]. -! ! - -!UIPainterView methodsFor:'drag & drop'! - -canDrop:anObjectOrCollection - Transcript showCR:'canDrop'. - ^ true - - -! - -drop:anObjectOrCollection at:aPoint - Transcript showCR:'drop:anObjectOrCollection at:aPoint'. - - -! ! - -!UIPainterView methodsFor:'event handling'! - -keyPress:key x:x y:y - - - key == #Copy ifTrue:[ - ^ self copySelection - ]. - - key == #Paste ifTrue:[ - ^ self pasteBuffer - ]. - - super keyPress:key x:x y:y - - - - - -! ! - -!UIPainterView ignoredMethodsFor:'generating output'! - -generateClassDefinition - |defCode| - - defCode := superclassName , ' subclass:#' , className , '\'. - defCode := defCode , ' instanceVariableNames:'''. - defCode := defCode , self subviewVariableNames , '''\'. - defCode := defCode , ' classVariableNames:''''\'. - defCode := defCode , ' poolDictionaries:''''\'. - defCode := defCode , ' category:''' , categoryName , '''\'. - defCode := defCode , Character excla asString , '\\'. - - ^ defCode withCRs - - - -! ! - -!UIPainterView methodsFor:'generating output'! - -generateCode - "generate code for the windowSpec method" - - |code| - - code := ''. - -"/ (Smalltalk classNamed:className asSymbol) isNil ifTrue:[ -"/ code := code , self generateClassDefinition. -"/ ]. -"/ code := code , self generateInitMethod. - - code := code , self generateWindowSpecMethodSource. - -"/ code := code , self generateAspectMethods. - - ^ code withCRs - - "Modified: 5.9.1995 / 20:57:53 / claus" -! ! - -!UIPainterView ignoredMethodsFor:'generating output'! - -generateInitCodeForGroup:aGroup - |code c name p objects outlets moreCode sym typ val| - - " := in:" - - code := ''. - - p := self propertyOfGroup:aGroup. - name := p at:#variableName. - c := ' ' , name , ' := ' , (aGroup class name) , ' new.\'. - - code := code , c withCRs. - - " :" - - objects := p at:#controlledObjects ifAbsent:[nil]. - objects notNil ifTrue:[ - objects do:[:controlledObject | - c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\' - ] - ]. - - code := code , c withCRs - - - - - -! - -generateInitCodeForOtherStuff - |code g c name p outlets moreCode sym typ val| - - code := ''. - - "generate code for groups" - - viewProperties do:[:props | - g := props at:#group ifAbsent:[nil]. - g notNil ifTrue:[ - code := code , (self generateInitCodeForGroup:g) - ] - ]. - ^ code - - -! - -generateInitCodeForView:aView - |code c name p outlets moreCode sym typ val| - - " := in:" - - code := ''. - - p := self propertyOfView:aView. - name := p at:#variableName. - c := ' ' , name , ' := ' , - (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'. - - " origin:(...) extent:(...)" - - c := c , ' ' , name , ' origin:(', aView origin printString , ')' - , ' extent:(', aView extent printString , ').\'. - - moreCode := p at:#initCode ifAbsent:nil. - moreCode notNil ifTrue:[ - c := c , moreCode , '\' withCRs - ]. - - code := code , c withCRs. - - " :" - - outlets := p at:#outlets ifAbsent:[nil]. - outlets notNil ifTrue:[ - outlets do:[:selectorOutlet | - sym := selectorOutlet at:#selector. - typ := selectorOutlet at:#type. - val := selectorOutlet at:#value. - c := ' ' , name , ' ' , sym. - (typ == #number) ifTrue:[ - c := c , val printString - ]. - (typ == #string) ifTrue:[ - c := c , '''' , val , '''' - ]. - (typ == #text) ifTrue:[ - c := c , '''' , val asString , '''' - ]. - (typ == #strings) ifTrue:[ - c := c , '#( '. - val asText do:[:aString | - c := c , '''' , aString , ''' ' - ]. - c := c , ')' - ]. - (typ == #block) ifTrue:[ - c := c , val - ]. - (typ == #color) ifTrue:[ - c := c , '(Color name:''' , val , ''')' - ]. - c := c , '.' , Character cr asString. - code := code , c - ] - ]. - - self subviewsOf:aView do:[:v | - code := code , (self generateInitCodeForView:v) - ]. - ^ code. - - "Modified: 5.9.1995 / 20:06:07 / claus" -! - -generateInitMethod - |defCode code| - - defCode := Character excla asString , - className , ' methodsFor:''initialization''' , - Character excla asString , '\\'. - - defCode := defCode , 'initialize\'. - defCode := defCode , ' super initialize.\'. - defCode := defCode , ' self setupSubViews.\'. - defCode := defCode , ' self setupLocalStuff\'. - defCode := defCode , Character excla asString , '\\'. - - defCode := defCode , 'setupSubViews\'. - code := defCode withCRs. - - self subviewsOf:self do:[:v | - code := code , (self generateInitCodeForView:v) - ]. - - code := code , (self generateInitCodeForOtherStuff). - - code := code , ' ^ self\' withCRs. - - defCode := Character excla asString , '\\'. - defCode := defCode , 'setupLocalStuff\'. - defCode := defCode , ' ^ self\'. - defCode := defCode , Character excla asString , ' ' , - Character excla asString , '\\'. - - code := code , defCode withCRs. - ^ code. - - - - -! - -generateOutlets - ^ self -! ! - -!UIPainterView methodsFor:'generating output'! - -generateSpecFor:something - "generate a spec for a view or collection of views - " - |spec views| - - something notNil ifTrue:[ - something isCollection ifTrue:[views := something] - ifFalse:[views := Array with:something]. - - spec := views collect:[:aView||topSpec| - aView specClass isNil ifTrue:[^ nil]. - - topSpec := aView specClass - fromView:aView - callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec]. - topSpec - ] - ]. - ^ spec - - - - - - -! - -generateWindowSpecMethodSource - |spec specArray str code| - - subViews remove:inputView. - [ - spec := FullSpec fromView:self callBack:[:newSpec :view | self stuffPropertiesFrom:view intoSpec:newSpec]. - ] valueNowOrOnUnwindDo:[ - subViews addFirst:inputView. - ]. - specArray := spec literalArrayEncoding. - - str := WriteStream on:String new. - self prettyPrintSpecArray:specArray on:str indent:5. - - code := Character excla asString - , className , ' class methodsFor:''interface specs''' - , Character excla asString , '\\' - - , methodName , '\' - , ' "this window spec was automatically generated by the ST/X UIPainter"\\' - , ' "do not manually edit this - the painter/builder may not be able to\' - , ' handle the specification if its corrupted."\\' - , ' "\' - , ' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\' - , ' ' , className , ' new openInterface:#' , methodName , '\' - , ' "\'. - - methodName = 'windowSpec' ifTrue:[ - code := code , ' "' , className , ' open"\' - ]. - code := code - , '\' - , ' \\' - , ' ^\' - , ' ', str contents - , '\' - , Character excla asString - , ' ' - , Character excla asString - , '\\'. - - ^ code withCRs - - "Modified: 5.9.1995 / 21:01:35 / claus" -! ! - -!UIPainterView ignoredMethodsFor:'generating output'! - -nameOfClass - ^ 'NewView' -! ! - -!UIPainterView methodsFor:'generating output'! - -outletValueOf:aSymbol for:aView -"/ |c name p outlets moreCode sym typ val| -"/ -"/ p := self propertyOfView:aView. -"/ outlets := p at:#outlets ifAbsent:[^ nil]. -"/ outlets notNil ifTrue:[ -"/ outlets do:[:selectorOutlet | -"/ sym := selectorOutlet at:#selector. -"/ (sym == aSymbol) ifTrue:[ -"/ typ := selectorOutlet at:#type. -"/ val := selectorOutlet at:#value. -"/ ^ val -"/ ] -"/ ] -"/ ]. - ^ nil - - - - -! - -prettyPrintSpecArray:spec on:aStream indent:i - "just for your convenience: prettyPrint a specArray to aStream - it looks better that way" - - |what oneLine| - - spec isArray ifFalse:[ - spec isLiteral ifTrue:[ - aStream nextPutAll:spec storeString - ] ifFalse:[ - self halt. - ]. - ^ self - ]. - - spec isEmpty ifTrue:[ - aStream nextPutAll:'#()'. - ^ self - ]. - - what := spec at:1. - what isArray ifTrue:[ - aStream cr; spaces:i+2. - aStream nextPutAll:'#('. - "/ a spec-collection - spec do:[:element | - self prettyPrintSpecArray:element on:aStream indent:i+2. - ]. - aStream cr. - aStream spaces:i+1. - aStream nextPutAll:')'. - ^ self. - ]. - - oneLine := false. - (#(#LayoutFrame #LayoutOrigin #AlignmentOrigin - #Rectangle #Point - #Color #ColorValue - ) - includesIdentical:what) ifTrue:[ - oneLine := true - ]. - - oneLine ifFalse:[ - aStream cr. - aStream spaces:i+2. - ]. - aStream nextPutAll:'#('. - - - aStream nextPutAll:what storeString. - - oneLine ifFalse:[ - aStream cr. - aStream spaces:i+4. - ]. - - 2 to:spec size do:[:index | - aStream space. - self prettyPrintSpecArray:(spec at:index) on:aStream indent:i+4. - oneLine ifFalse:[ - (index odd and:[index ~~ (spec size)]) ifTrue:[ - aStream cr; spaces:i+4. - ] - ] - ]. - oneLine ifFalse:[ - aStream cr. - aStream spaces:i+1. - ]. - aStream nextPutAll:')'. - - "Modified: 5.9.1995 / 17:44:20 / claus" -! - -storeContentsOn:aStream - viewProperties do:[:p| p storeOn:aStream] -! - -stuffPropertiesFrom:view intoSpec:newSpec - "stuff any additional information (held in the properties) into the spec - which was just created from view" - - |props aspectSelector changeSelector labelSelector name tabable| - - props := self propertyOfView:view. - props isNil ifTrue:[^ self]. - - (aspectSelector := props aspectSelector) notNil ifTrue:[ - newSpec model:aspectSelector - ]. - (changeSelector := props changeSelector) notNil ifTrue:[ - newSpec change:changeSelector - ]. - (labelSelector := props labelSelector) notNil ifTrue:[ - newSpec label:labelSelector - ]. - (tabable := props tabable) notNil ifTrue:[ - newSpec tabable:tabable - ]. - (name := props name) notNil ifTrue:[ - newSpec name:name - ]. - -! ! - -!UIPainterView ignoredMethodsFor:'generating output'! - -subviewVariableNames - |names| - - names := ''. - viewProperties do:[:p| names := names , ' ' , (p name)]. - ^ names -! ! - -!UIPainterView methodsFor:'generating output'! - -subviewsOf:aView do:aBlock - |subs v| - - (subs := aView subViews) notNil ifTrue:[ - subs do:[:v| - (v ~~ inputView and:[v notNil]) ifTrue:[ - (viewProperties detect:[:p | p view == v] ifNone:nil) notNil ifTrue:[ - (v superView == aView) ifTrue:[ - aBlock value:v - ] - ] - ] - ] - ] - -! ! - -!UIPainterView methodsFor:'group manipulations'! - -groupEnterFields - |props name index group objects| - - selection isNil ifTrue:[^ self]. - self selectionDo:[:aView | - (aView isKindOf:EditField) ifFalse:[ - self warn:'select EditFields only !!'. - ^ self - ] - ]. - self selectionHiddenDo:[ - group := EnterFieldGroup new. - - props := GroupProperties new. - props elementClass:EnterFieldGroup. - props group:group. - index := self variableIndexForClass:EnterFieldGroup. - props nameIndex:index. - name := self variableNameForClass:EnterFieldGroup index:index. - props name:name. - objects := OrderedCollection new. - props controlledObjects:objects. - viewProperties add:props. - - self selectionDo:[:aView | - objects add:aView. - group add:aView - ]. - ] - - -! - -groupRadioButtons - |props name index group objects| - - selection isNil ifTrue:[^ self]. - self selectionDo:[:aView | - (aView isKindOf:RadioButton) ifFalse:[ - self warn:'select RadioButtons only !!'. - ^ self - ] - ]. - self selectionHiddenDo:[ - group := RadioButtonGroup new. - - props := GroupProperties new. - props elementClass:RadioButtonGroup. - props group:group. - index := self variableIndexForClass:RadioButtonGroup. - props nameIndex:index. - name := self variableNameForClass:RadioButtonGroup index:index. - props name:name. - group groupID:name asSymbol. - objects := OrderedCollection new. - props controlledObjects:objects. - viewProperties add:props. - - self selectionDo:[:aView | - aView turnOff. - objects add:aView. - group add:aView - ]. - ] - - "Modified: 5.9.1995 / 16:06:15 / claus" -! ! - -!UIPainterView methodsFor:'initialization'! - -initialize - super initialize. - - superclassName := 'ApplicationModel'. - className := 'NewApplication'. - methodName := 'windowSpec'. - categoryName := 'Applications'. - viewProperties := OrderedCollection new. - HandCursor := Cursor leftHand. - - "Modified: 5.9.1995 / 19:58:06 / claus" -! ! - -!UIPainterView methodsFor:'interface to Builder'! - -addOutletDefinitionFor:outletSymbol type:type value:outletValue for:aView - |outletProps selectorProps viewProps| - - viewProps := self propertyOfView:aView. -"/ outletProps := viewProps at:#outlets ifAbsent:[nil]. -"/ outletProps isNil ifTrue:[ -"/ outletProps := Dictionary new. -"/ viewProps at:#outlets put:outletProps -"/ ]. -"/ selectorProps := outletProps at:outletSymbol ifAbsent:[nil]. -"/ selectorProps isNil ifTrue:[ -"/ selectorProps := Dictionary new. -"/ outletProps at:outletSymbol put:selectorProps -"/ ]. -"/ -"/ selectorProps at:#selector put:outletSymbol. -"/ selectorProps at:#type put:type. -"/ selectorProps at:#value put:outletValue - -! - -addSpec:specOrSpecArray - |spec builder| - - spec := UISpecification from:specOrSpecArray. - - builder := UIBuilder new. - builder componentCreationHook:[:view :spec :aBuilder | - self createdComponent:view forSpec:spec builder:aBuilder - ]. - builder applicationClass:(Smalltalk classNamed:className). - spec setupView:self for:builder. - - self realizeAllSubViews. - inputView raise. - -"/ viewProperties := OrderedCollection new. -"/ self generatePropertiesFor:(self subViews select:[:v | v ~~ inputView]). - - self changed:#tree. - - - "Modified: 5.9.1995 / 23:36:55 / claus" -! - -applicationName - ^ className -! - -aspectAt:aSymbol - self halt. - ^ nil - - "Modified: 6.9.1995 / 00:45:35 / claus" -! - -aspectSelectorForView:aView - |props aspect| - - props := self propertyOfView:aView. - props isNil ifTrue:[^ nil]. - ^ props aspectSelector - -! - -changeSelectorForView:aView - |props aspect| - - props := self propertyOfView:aView. - props isNil ifTrue:[^ nil]. -"/ ^ props changeSelector - ^ nil -! - -createdComponent:newView forSpec:aSpec builder:aBuilder - "callBack from UISpec view building" - - |props| - - props := self propertiesForNewView:newView. - - aSpec name notNil ifTrue:[ - (self propertyOfName:(aSpec name)) isNil ifTrue:[ - props name:aSpec name - ] - ]. - - props labelSelector:(aSpec labelSelector). - props aspectSelector:(aSpec modelSelector). - props tabable:(aSpec tabable). - - viewProperties add:props. -! - -generatePropertiesFor:aCollectionOfViews - - "/ done as two loops, to get bread-first naming - - aCollectionOfViews do:[:aView| - |props| - - props := self propertiesForNewView:aView. - viewProperties add:props. - aView name:(props name). - - aView geometryLayout isNil ifTrue:[ - aView geometryLayout:(aView bounds asLayout). - ] - ]. - - aCollectionOfViews do:[:aView | - |subs| - - subs := aView subViews. - subs notNil ifTrue:[ - self generatePropertiesFor:subs - ] - ]. - -! - -inspectAttributes - |p| - - self singleSelectionDo:[:aView | - p := self propertyOfView:aView. - p inspect - ] -! - -inspectSpec - |s| - - self singleSelectionDo:[:aView | - s := self generateSpecFor:aView. - s first inspect - ] -! - -setAspectSelector:aspectSymbol forView:aView - |props| - - props := self propertyOfView:aView. - - props notNil ifTrue:[ - self transaction:#aspect selectionDo:[:aView| - |oldAspect| - - oldAspect := props aspectSelector. - - undoHistory addUndoBlock:[ - props aspectSelector:oldAspect. - aView superView sizeChanged:nil - ] - ]. - props aspectSelector:aspectSymbol - ] -! - -setChangeSelector:changeSymbol forView:aView - |props| - - props := self propertyOfView:aView. - props notNil ifTrue:[ - props changeSelector:changeSymbol - ] -! - -setupFromSpec:specOrSpecArray - self removeAll. - self addSpec:specOrSpecArray -! - -showFontPanel - |action| - - fontPanel isNil ifTrue:[ - fontPanel := FontPanel new - ]. - - selection notNil ifTrue:[ - action := [:family :face :style :size | - self changeFontFamily:family face:face - style:style size:size - ]. - fontPanel action:action. - fontPanel showAtPointer - ] -! ! - -!UIPainterView methodsFor:'menu & submenus'! - -menu - testMode ifFalse:[ - selection notNil ifTrue:[^ self menuSelection ] - ifFalse:[^ self menuPainter ] - ]. - ^ nil -! - -menuPainter - "menu in case of non empty selection; for views - " - |menu gridMenu| - - menu := PopUpMenu labels:( - resources array:#( - 'paste' - '-' - 'undo' - 'delete undo history' - '-' - 'grid' - ) - ) - selectors:#( - #pasteBuffer - nil - #undo - #undoDeleteAll - nil - #grid - ) - accelerators:#( - #Paste - nil - nil - nil - nil - nil - ) - receiver:self. - - (self canPaste:(self getSelection)) ifFalse:[ - menu disable:#pasteBuffer - ]. - - undoHistory isEmpty ifTrue:[ - menu disable:#undo - ] ifFalse:[ - menu subMenuAt:#undo put:(undoHistory popupMenu) - ]. - - gridMenu := PopUpMenu labels:( - resources array:#( - '\c show' - '\c align' - ) - ) - selectors:#( - #gridShown: - #gridAlign: - ). - - gridMenu checkToggleAt:#gridShown: put:(self gridShown). - gridMenu checkToggleAt:#gridAlign: put:aligning. - menu subMenuAt:#grid put:gridMenu. - - ^ menu - - -! - -menuSelection - "menu in case of non empty selection; for views - " - |menu| - - menu := PopUpMenu labels:( resources array:#( - 'copy' - 'cut' - 'paste' - '-' - 'arrange' - 'dimension' - 'align' - ) - ) - selectors:#( #copySelection - #deleteSelection - #pasteBuffer - nil - #arrange - #dimension - #align - ) - accelerators:#(#Copy - #Cut - #Paste - nil - nil - nil - nil - ) - receiver:self. - - ( (self canPaste:(self getSelection)) - and:[self supportsSubComponents:selection] - ) ifFalse:[ - menu disable:#pasteBuffer - ]. - - menu subMenuAt:#arrange put:(self subMenuArrange). - menu subMenuAt:#dimension put:(self subMenuDimension). - menu subMenuAt:#align put:(self subMenuAlign). - ^ menu -! - -subMenuAlign - "returns submenu alignment - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'align left' - 'align right' - 'align left & right' - 'align top' - 'align bottom' - 'align centered vertical' - 'align centered horizontal' - '-' - 'spread horizontal' - 'spread vertical' - 'center horizontal in frame' - 'center vertical in frame' - ) - ) - - selectors:#( - alignSelectionLeft - alignSelectionRight - alignSelectionLeftAndRight - alignSelectionTop - alignSelectionBottom - alignSelectionCenterHor - alignSelectionCenterVer - nil - spreadSelectionHor - spreadSelectionVer - centerSelectionHor - centerSelectionVer - ) - receiver:self. - ^ menu - -! - -subMenuArrange - "returns submenu arrange - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'to front' - 'to back' - ) - ) - selectors:#( - raiseSelection - lowerSelection - ) - receiver:self. - ^ menu -! - -subMenuDimension - "returns submenu dimension - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'default extent' - 'default width' - 'default height' - '-' - 'copy extent' - '-' - 'paste extent' - 'paste width' - 'paste height' - ) - ) - selectors:#( - setToDefaultExtent - setToDefaultWidth - setToDefaultHeight - nil - copyExtent - nil - pasteExtent - pasteWidth - pasteHeight - ) - receiver:self. - ^ menu -! - -subMenuFont - "returns submenu dimension - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'larger' - 'smaller' - '-' - 'normal' - 'bold' - 'italic' - 'bold italic' - '-' - 'font panel' - ) - ) - selectors:#( - largerFont - smallerFont - nil - normalFont - boldFont - italicFont - boldItalicFont - nil - showFontPanel - ) - receiver:self. - ^ menu -! ! - -!UIPainterView methodsFor:'menu actions'! - -copySelection - "copy the selection into the cut&paste-buffer - " - |specs| - - specs := self generateSpecFor:selection. - - specs notNil ifTrue:[ - self setSelection:specs - ]. - self unselect. -! - -deleteSelection - "delete the selection - " - |specs text| - - self numberOfSelections ~~ 0 ifTrue:[ - specs := self generateSpecFor:selection. - text := self transactionTextFor:selection. - - undoHistory transaction:#cut text:text do:[ - super deleteSelection - ]. - self setSelection:specs - ] -! - -gridAlign:aBool - aBool ifTrue:[self alignOn] - ifFalse:[self alignOff] -! - -gridShown:aBool - aBool ifTrue:[self showGrid] - ifFalse:[self hideGrid] - -! - -lowerSelection - - self selectionDo:[:aView| aView lower ]. -! - -pasteBuffer - "add the objects in the paste-buffer - " - |paste builder frame pasteOrigin pasteOffset| - - paste := self getSelection. - - (self canPaste:paste) ifFalse:[ ^ self]. - (paste isCollection) ifFalse:[ paste := Array with:paste]. - - frame := self singleSelection. - - (self supportsSubComponents:frame) ifFalse:[ - frame := self - ]. - self unselect. - - builder := UIBuilder new. - selection := OrderedCollection new. - pasteOffset := 0@0. - pasteOrigin := self sensor mousePoint. - pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id. - - paste do:[:aSpec| - |v org| - - builder componentCreationHook:[:view :spec :aBuilder | - self createdComponent:view forSpec:spec builder:aBuilder. - ]. - builder applicationClass:(Smalltalk classNamed:className). - v := aSpec buildViewWithLayoutFor:builder in:frame. - - (frame bounds containsPoint:pasteOrigin) ifFalse:[ - self moveObject:v to:pasteOffset. - ] ifTrue:[ - self moveObject:v to:pasteOrigin + pasteOffset. - ]. - - v realize. - selection add:v. - - pasteOffset := pasteOffset + 4. - ]. - - self transaction:#paste selectionDo:[:v| - self undoCreate:((self propertyOfView:v) identifier) - ]. - selection size == 1 ifTrue:[ - selection := selection at:1 - ]. - self showSelection. - self realizeAllSubViews. - inputView raise. - self changed:#tree - -! - -raiseSelection - - self selectionDo:[:aView| - aView raise. - inputView raise. - ]. - -! ! - -!UIPainterView methodsFor:'misc'! - -changeFontFamily:family face:face style:style size:size - |f| - - f := Font family:family - face:face - style:style - size:size. - - f notNil ifTrue:[ - self selectionHiddenDo:[ - self selectionDo:[:aView | - aView font:f. - self elementChanged:aView. - ] - ] - ] - - "Modified: 5.9.1995 / 12:13:27 / claus" -! - -changeVariableNameOf:aView to:newName - |prop| - - prop := self propertyOf:aView. - - prop isNil ifTrue:[ - ^ self error:'no such view' - ]. - - ((aView respondsTo:#label:) and:[aView label = prop name]) ifTrue:[ - self selectionHiddenDo:[ - |layout| - layout := aView geometryLayout copy. - aView label:newName. - aView geometryLayout:layout. - ] - ]. - - prop name:newName. - aView name:newName. - self changed:#widgetName - - - -! - -variableIndexForClass:aClass - |max| - - max := 0. - - viewProperties do:[:p| - p elementClass == aClass ifTrue:[ - max := max max:(p nameIndex) - ] - ]. - ^ max + 1 - -! - -variableNameForClass:aClass index:index - |n| - - n := (aClass name) , index printString. - n at:1 put:(n at:1) asLowercase. - ^ n - -! - -variableNameOf:aView - |prop| - - aView notNil ifTrue:[ - prop := self propertyOf:aView - ]. - - prop notNil ifTrue:[^ prop name] - ifFalse:[^ 'self'] - -! ! - -!UIPainterView methodsFor:'removing components'! - -remove:something - "remove something, anObject or a collection of objects from the contents - do redraw" - - self forEach:something do:[:anObject | - self removeObject:anObject - ] - - -! - -removeAll - "remove the argument, anObject" - - self unselect. - - subViews notNil ifTrue:[ - subViews copy do:[:sub | - sub ~~ inputView ifTrue:[ - self removeTreeFrom:sub - ] - ] - ]. - - viewProperties := OrderedCollection new. - undoHistory reinitialize. - self changed:#tree -! - -removeObject:anObject - "remove the argument, anObject" - - self removeTreeFrom:anObject. - self changed:#tree - - "Modified: 5.9.1995 / 20:51:28 / claus" -! - -removeTreeFrom:anObject - "remove the argument, anObject and all of its children - " - |props| - - anObject notNil ifTrue:[ - (anObject subViews notNil) ifTrue:[ - anObject subViews copy do:[:sub | - self removeTreeFrom:sub - ] - ]. - props := self propertyOf:anObject. - - props notNil ifTrue:[ - self undoRemove:props. - viewProperties remove:props - ]. - anObject destroy - ] -! ! - -!UIPainterView methodsFor:'searching'! - -findObjectAt:aPoint - "find the origin/corner of the currentWidget - " - |view| - - view := super findObjectAt:aPoint. - - view notNil ifTrue:[ - "can be a view within a view not visible - " - [ (self propertyOfView:view) isNil ] whileTrue:[ - (view := view superView) == self ifTrue:[^ nil] - ] - ]. - ^ view -! ! - -!UIPainterView methodsFor:'seraching property'! - -propertyOf:something - - ^ viewProperties detect:[:p| (p view == something or:[p group == something])] - ifNone:nil - - - - - -! - -propertyOfGroup:aGroup - - ^ viewProperties detect:[:p| p group == aGroup] ifNone:nil -! - -propertyOfIdentifier:anIdentifier - - ^ viewProperties detect:[:p| p identifier == anIdentifier] ifNone:nil. -! - -propertyOfName:aString - - aString = 'self' ifFalse:[ - ^ viewProperties detect:[:p| p name = aString] ifNone:nil - ]. - ^ nil -! - -propertyOfView:aView - - aView == self ifFalse:[ - ^ viewProperties detect:[:p| p view == aView] ifNone:nil - ]. - ^ nil -! ! - -!UIPainterView methodsFor:'testing'! - -isHorizontalResizable:aComponent - - (aComponent isKindOf:ScrollBar) ifTrue:[ - ^ aComponent orientation == #horizontal - ]. - (aComponent isKindOf:Scroller) ifTrue:[ - ^ aComponent orientation == #horizontal - ]. - (aComponent isKindOf:Slider) ifTrue:[ - ^ aComponent orientation == #horizontal - ]. - ^ true - - -! - -isVerticalResizable:aComponent - - (aComponent isKindOf:EditField) ifTrue:[ - ^ false - ]. - (aComponent isKindOf:ComboBoxView) ifTrue:[ - ^ false - ]. - (aComponent isKindOf:CheckBox) ifTrue:[ - ^ false - ]. - (aComponent isKindOf:ScrollBar) ifTrue:[ - ^ aComponent orientation == #vertical - ]. - (aComponent isKindOf:Scroller) ifTrue:[ - ^ aComponent orientation == #vertical - ]. - (aComponent isKindOf:Slider) ifTrue:[ - ^ aComponent orientation == #vertical - ]. - ^ true - - -! ! - -!UIPainterView methodsFor:'transaction & undo'! - -transaction:aType objects:something do:aOneArgBlock - "opens a transaction and evaluates a block within the transaction; the - argument to the block is a view from derived from something - " - |text| - - something notNil ifTrue:[ - text := self transactionTextFor:something. - - undoHistory transaction:aType text:text do:[ - something isCollection ifTrue:[ - something do:[:aView| aOneArgBlock value:aView ] - ] ifFalse:[ - aOneArgBlock value:something - ] - ] - ] -! - -transactionTextFor:anElementOrCollection - "returns text used by transaction or nil - " - |props size| - - anElementOrCollection notNil ifTrue:[ - anElementOrCollection isCollection ifTrue:[ - size := anElementOrCollection. - size == 0 ifTrue:[^ nil]. - size ~~ 1 ifTrue:[^ 'a collection']. - - props := self propertyOfView:(anElementOrCollection at:1). - ] ifFalse:[ - props := self propertyOfView:anElementOrCollection - ]. - props notNil ifTrue:[ ^ props name ] - ]. - ^ nil -! - -undoCreate:aViewIdentifier - - undoHistory isTransactionOpen ifTrue:[ - undoHistory addUndoBlock:[ - |props| - - props := self propertyOfIdentifier:aViewIdentifier. - - props notNil ifTrue:[ - self removeObject:(props view) - ] - ] - ] -! - -undoRemove:propertyOfView - |clsName layout parent aView| - - (propertyOfView notNil and:[undoHistory isTransactionOpen]) ifFalse:[ - ^ self - ]. - - aView := propertyOfView view. - clsName := aView class. - layout := aView geometryLayout. - parent := aView superView. - - parent ~~ self ifTrue:[ - parent := (self propertyOf:parent) identifier. - ] ifFalse:[ - parent := nil - ]. - propertyOfView view:nil. - - undoHistory addUndoBlock:[ - |recreatedView props| - - parent notNil ifTrue:[ - props := self propertyOfIdentifier:parent. - - props notNil ifTrue:[parent := props view] - ifFalse:[parent := self] - ] ifFalse:[ - parent := self - ]. - - recreatedView := clsName in:parent. - recreatedView geometryLayout:layout. - propertyOfView view:recreatedView. - self addProperties:propertyOfView for:recreatedView. - recreatedView realize. - inputView raise. - ]. - aView := nil. - -! ! - -!UIPainterView methodsFor:'update from Specification'! - -updateFromSpec:aSpec - "update current selected view from specification - " - self singleSelection notNil ifTrue:[ - self selectionHiddenDo:[ - self transaction:#specification selectionDo:[:aView| - |spec builder| - - spec := (self generateSpecFor:aView) first. - - undoHistory addUndoBlock:[ - builder := UIBuilder new. - spec setAttributesIn:aView with:builder. - aView superView sizeChanged:nil - ]. - builder := UIBuilder new. - aSpec setAttributesIn:aView with:builder. - aView superView sizeChanged:nil. - (self propertyOfView:aView) tabable:aSpec tabable. - ]. - self changed:#tree - ] - ] - -! ! - !UIPainterView::ViewProperty class methodsFor:'instance creation'! new @@ -1759,6 +40,16 @@ changeSelector := something.! +defaultable + "return the value of the instance variable 'defaultable' (automatically generated)" + + ^ defaultable! + +defaultable:something + "set the value of the instance variable 'defaultable' (automatically generated)" + + defaultable := something.! + elementClass "return the value of the instance variable 'elementClass' (automatically generated)" @@ -1779,6 +70,16 @@ ^ identifier ! +initiallyInvisible + "return the value of the instance variable 'initiallyInvisible' (automatically generated)" + + ^ initiallyInvisible! + +initiallyInvisible:something + "set the value of the instance variable 'initiallyInvisible' (automatically generated)" + + initiallyInvisible := something.! + labelSelector "return the value of the instance variable 'labelSelector' (automatically generated)" @@ -1789,6 +90,16 @@ labelSelector := something.! +menuSelector + "return the value of the instance variable 'menuSelector' (automatically generated)" + + ^ menuSelector! + +menuSelector:something + "set the value of the instance variable 'menuSelector' (automatically generated)" + + menuSelector := something.! + name "return the value of the instance variable 'name' (automatically generated)" @@ -1838,30 +149,3 @@ identifier := Identifier ! ! -!UIPainterView::GroupProperties methodsFor:'accessing'! - -controlledObjects - "return the value of the instance variable 'controlledObjects' (automatically generated)" - - ^ controlledObjects! - -controlledObjects:something - "set the value of the instance variable 'controlledObjects' (automatically generated)" - - controlledObjects := something.! - -group - "return the value of the instance variable 'group' (automatically generated)" - - ^ group! - -group:something - "set the value of the instance variable 'group' (automatically generated)" - - group := something.! ! - -!UIPainterView class methodsFor:'documentation'! - -version - ^ '$Header$' -! ! diff -r 668eb9eae2ac -r 0a2b2ff030a0 UIPropertyView.st --- 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