# HG changeset patch # User Claus Gittinger # Date 856879629 -3600 # Node ID 7542ab7fbbfed6b196f4fbdb28647fb7b93c4e6d # Parent 0a2b2ff030a090c930842e55713c14ec7490d5da *** empty log message *** diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIObjectView.st --- a/UIObjectView.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIObjectView.st Tue Feb 25 15:07:09 1997 +0100 @@ -1,3 +1,20 @@ +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:24 pm' ! + +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:'' @@ -5,6 +22,2064 @@ 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'! + +gridAlign + ^ aligning + +! + +gridAlign:aBool + aBool ifTrue:[self alignOn] + ifFalse:[self alignOff] + +! + +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) + + +! + +gridShown:aBool + aBool ifTrue:[self showGrid] + ifFalse:[self hideGrid] +! + +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'! + +XXstartCreate: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. + + +! + +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 object| + + object := actionData object. + self invertOutlineOf:object. + inputView raise. + + object superView specClass basicNew setupInitialLayoutFor:object. + + self changed:#tree. + self select: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. + ]. + + (widget := self singleSelection) notNil ifTrue:[ + self unselect. + + (self isPoint:aPoint containedIn:widget) ifFalse:[ + widget := self + ] ifTrue:[ + (self supportsSubComponents:widget) ifFalse:[ + ^ self setDefaultActions. + ] + ] + ] ifFalse:[ + widget := self + ]. + + motionAction := [:movePoint| self doDragCreate:movePoint]. + releaseAction := [ self endCreate]. + + 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 undoLayoutView: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. + super select:(actionData object). + self changed:#layout. + actionData := nil +! + +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 undoLayoutView: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. + + self undoLayoutView:aView. + + layout isLayout ifTrue:[ + 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| + + 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 listOfViews| + + 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]. + + "/ look for 'hidden' views ... + + listOfViews := OrderedCollection new. + self allSubViewsDo:[:aView | + |org| + + aView ~~ inputView ifTrue:[ + org := device translatePoint:0@0 from:(aView id) to:self id. + ((org extent:aView extent) containsPoint:aPoint) ifTrue:[ + listOfViews add:aView. + ] + ] + ]. + + listOfViews size > 0 ifTrue:[ + ^ listOfViews last + ]. + ^ 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'! + +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 + + +! + +undoLayoutView:aView + "prepare undo action for a view changing its layout + " + self subclassResponsibility + +! ! + +!UIObjectView methodsFor:'user actions - arrange'! + +lowerSelection + self selectionDo:[:aView| aView lower ]. + + +! + +raiseSelection + self selectionDo:[:aView| aView raise ]. + inputView raise. + + +! ! + +!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 undoLayoutView:aView. + aOneArgBlock value:aView. + ]. + 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 undoLayoutView: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 undoLayoutView: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 undoLayoutView: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 undoLayoutView: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 undoLayoutView: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 undoLayoutView: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 methodsFor:'user actions - undo history'! + +openUndoMenu + self unselect. + undoHistory openUndoMenu. + self changed:#tree + +! + +removeUndoHistory + "delete total undo history + " + undoHistory reinitialize +! + +undoLast + self unselect. + undoHistory undoLast:1. + self changed:#tree +! ! + +!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'! + +openUndoMenu + |list top slv hzp inset selection okButton| + + history isEmpty ifTrue:[ + ^ self + ]. + + top := StandardSystemView new label:'undo history'; extent:250@350. + slv := ScrollableView for:SelectionInListView origin:0.0@0.0 corner:1.0@1.0 in:top. + hzp := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top. + hzp horizontalLayout:#fitSpace. + + (Button abortButtonIn:hzp) action:[ selection := nil. top destroy ]. + okButton := Button okButtonIn:hzp. + okButton label:'undo to end'. + okButton action:[ top destroy ]. + + inset := hzp preferredExtent y. + hzp topInset:(inset negated). + slv bottomInset:inset. + slv := slv scrolledView. + + list := history collect:[:aTrans||e| + e := MultiColListEntry new. + e colAt:1 put:(aTrans type asString). + e colAt:2 put:(aTrans text ? ''). + e + ]. + + slv list:list. + slv action:[:index | selection := index ]. + top openModal. + + selection notNil ifTrue:[ + self undoLast:(history size - selection + 1). + ] +! ! + +!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:'documentation'! + +version + ^ '$Header$' +! ! + !UIObjectView::UndoHistory::Transaction class methodsFor:'instance creation'! type:aType text:aTextOrNil @@ -98,3 +2173,8 @@ ^ actions notNil ! ! +!UIObjectView class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIPainter.st --- a/UIPainter.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIPainter.st Tue Feb 25 15:07:09 1997 +0100 @@ -1,3 +1,25 @@ +" + 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. +" + +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:26 pm' ! + +ApplicationModel subclass:#UIPainter + instanceVariableNames:'topView workView propertyView treeView elementMenu fileName + specClass specSelector specSuperclass aspects' + classVariableNames:'' + poolDictionaries:'' + category:'Interface-UIPainter' +! + HorizontalPanelView subclass:#ButtonPanel instanceVariableNames:'receiver argumentToSelector' classVariableNames:'' @@ -5,6 +27,961 @@ 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'! + +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:UIPainter andSelector:#nameAndSelectorSpec + UIPainter new openInterface:#nameAndSelectorSpec + " + + + + ^ + + #(#FullSpec + #'isOpaque:' true + #'window:' + #(#WindowSpec + #'name:' 'uIPainterView' + #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) + #'isOpaque:' true + #'label:' 'unnamed' + #'bounds:' #(#Rectangle 0 0 300 300) + ) + #'component:' + #(#SpecCollection + #'collection:' + #( + #(#LabelSpec + #'name:' 'label1' + #'layout:' #(#LayoutFrame 10 0 50 0 110 0 70 0) + #'isOpaque:' true + #'label:' 'class:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#LabelSpec + #'name:' 'label2' + #'layout:' #(#LayoutFrame 10 0 90 0 110 0 110 0) + #'isOpaque:' true + #'label:' 'superclass:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#LabelSpec + #'name:' 'label3' + #'layout:' #(#LayoutFrame 10 0 130 0 110 0 150 0) + #'isOpaque:' true + #'label:' 'selector:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#InputFieldSpec + #'name:' 'classNameField' + #'layout:' #(#LayoutFrame 120 0 50 0 289 0 69 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #classNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'hasBorder:' false + ) + #(#InputFieldSpec + #'name:' 'superclassNameField' + #'layout:' #(#LayoutFrame 120 0 90 0 289 0 109 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #superclassNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'hasBorder:' false + ) + #(#InputFieldSpec + #'name:' 'methodNameField' + #'layout:' #(#LayoutFrame 120 0 130 0 289 0 149 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #methodNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'numChars:' 5 + #'hasBorder:' false + ) + #(#ActionButtonSpec + #'name:' 'button1' + #'layout:' #(#LayoutFrame 30 0 250 0 129 0 279 0) + #'isOpaque:' true + #'label:' 'cancel' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'tabable:' true + #'isDefault:' false + #'defaultable:' false + #'model:' #cancel + #'hasCharacterOrientedLabel:' true + #'isDecorated:' false + #'initiallyDisabled:' false + ) + #(#ActionButtonSpec + #'name:' 'button2' + #'layout:' #(#LayoutFrame 160 0 250 0 259 0 279 0) + #'isOpaque:' true + #'label:' 'ok' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'tabable:' true + #'isDefault:' true + #'defaultable:' false + #'model:' #accept + #'hasCharacterOrientedLabel:' true + #'isDecorated:' false + #'initiallyDisabled:' false + ) + #(#LabelSpec + #'name:' 'boxLabel' + #'layout:' #(#LayoutOrigin 78 0 11 0) + #'isOpaque:' true + #'label:' 'class & selector for code' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #center + #'hasCharacterOrientedLabel:' true + ) + ) + ) + ) +! ! + +!UIPainter methodsFor:'BuilderView interface'! + +update:something + + elementMenu deselect. + treeView update:something. + propertyView update:something. +! ! + +!UIPainter methodsFor:'aspects'! + +aspectFor:aKey + ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ] + +! ! + +!UIPainter methodsFor:'filein & fileout'! + +openFile:aFileName + |aStream | + + aStream := FileStream readonlyFileNamed:aFileName. + + aStream notNil ifTrue:[ + workView fileInContentsFrom:aStream. + aStream close. + fileName := aFileName + ] + +! + +saveAs:aFileName + |aStream| + + aStream := FileStream newFileNamed:aFileName. + + aStream notNil ifTrue:[ + workView storeContentsOn:aStream. + aStream close. + fileName := 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" +! + +initChannels + |cls| + + aspects := IdentityDictionary new. + + aspects 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. + ] + ] + ]. + aspects at:#superclassNameChannel put:( + (specSuperclass notNil ifTrue:[specSuperclass] + ifFalse:['ApplicationModel']) asValue + ). + aspects at:#methodNameChannel put:( + (specSelector notNil ifTrue:[specSelector] + ifFalse:[#windowSpec]) asValue + ). +! + +initPullDownMenu:aMenu + aMenu labels:(resources array:#( + 'file' + 'font' + 'type' + 'align' + 'dimension' + 'special' + 'misc' + 'code' + 'test' + )). + + aMenu selectors:#(#file + #font + #type + #align + #dimension + #special + #misc + #code + #test + ). + + aMenu at:#file + putLabels:(resources array: + #('new' + 'from class ...' + 'pick a view ' + '-' + 'load' + 'save' + 'save as ...' + '-' + 'install spec' + 'install aspects' + '-' +"/ 'source' + 'windowSpec' + 'inspect me' + 'raise' + '-' + 'print' + '-' + 'quit' + )) + selectors:#(doNew + doFromClass + doPickAView + nil + doOpen + doSave + doSaveAs + nil + doInstallSpec + doInstallAspects + nil +"/ doSource + doWindowSpec + inspect + doRaise + nil + doPrint + nil + doFinish + ) + receiver:self. + + aMenu at:#font putMenu:(workView subMenuFont menuView). + + aMenu at:#type + putLabels:(resources array:#( + 'basic widgets' + 'layout' + 'text' + 'interactors' + 'modal' + 'other' + '-' + 'all' + ) ) + selectors:#(showBasicWidgets + showLayoutWidgets + showTextWidgets + showInteractorWidgets + showModalWidgets + showOtherWidgets + nil + showAllWidgets + ) + receiver:self. + + aMenu at:#align putMenu:(workView subMenuAlign menuView). + aMenu at:#dimension putMenu:(workView subMenuDimension menuView). + + aMenu at:#special + putLabels:(resources array:#( + 'group radioButtons' + 'group enterFields' + '-' + 'delete undo history' + ) ) + selectors:#( + groupRadioButtons + groupEnterFields + nil + removeUndoHistory + ) + receiver:workView. + + aMenu at:#code + putLabels:(resources array:#( + 'class & method' + ) ) + selectors:#( + defineClassAndSelector + ) + receiver:self. + + aMenu at:#misc putMenu:(self menuMisc). + + aMenu at:#test + putLabels:(resources array:#( + '\c test mode' + ) ) + selectors:#(doToggleTest + ) + receiver:self. + + (aMenu menuAt:#test) checkToggleAt:#doToggleTest put:(workView testMode). +! + +openInterface + |inset panel menu| + + super initialize. + self initChannels. + 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. + panel := ButtonPanel in:topView. + inset := menu preferredExtent y + panel preferredExtent y. + + panel origin:0.0@(menu preferredExtent y) corner:1.0@inset . + panel receiver:workView. + + elementMenu := HVScrollableView for:SelectionInListView miniScrollerH:true in:topView. + elementMenu origin:0.0@0.0 corner:0.3 @ 1.0. + elementMenu topInset:inset . + elementMenu := elementMenu scrolledView. + + elementMenu action:[:selection | + workView testMode ifTrue:[ + elementMenu deselect + ] ifFalse:[ + selection notNil ifTrue:[ + workView createWidgetWithClass: + (Smalltalk at:(elementMenu selectionValue asSymbol)) + ] + ] + ]. + + treeView := HVScrollableView for:UIPainterTreeView miniScrollerH:true in:topView. + treeView origin:0.3 @ 0.0 corner:0.6@1.0. + treeView topInset:inset . + treeView := treeView scrolledView. + treeView builderView:workView. + + propertyView := View origin:(0.6 @ 0.0) corner:1.0@1.0 in:topView. + propertyView topInset:inset . + propertyView := UIPropertyView in:propertyView receiver:workView. + + workView addDependent:self. + self initPullDownMenu:menu. + topView application:self. + builder window:topView. + topView beMaster. + workView topView beSlave. + topView open. + workView topView openInGroup:(topView windowGroup). +! + +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:'menus'! + +menuMisc + + |menuView menuGrid menuUndo| + + menuView := MenuView labels: + (resources array:#( + 'grid' + 'undo' + ) + ) + selectors:#( + #grid + #undo + ) + receiver:self. + + + menuGrid := PopUpMenu labels:( + resources array:#( + '\c show' + '\c align' + ) + ) + selectors:#( + #gridShown: + #gridAlign: + ) + receiver:workView. + + menuGrid checkToggleAt:#gridShown: put:(workView gridShown). + menuGrid checkToggleAt:#gridAlign: put:(workView gridAlign). + menuView subMenuAt:#grid put:menuGrid. + + menuUndo := PopUpMenu labels:( + resources array:#( + 'last' + 'menu' + '-' + 'delete' + ) + ) + selectors:#( + #undoLast + #openUndoMenu + nil + #removeUndoHistory + ) + receiver:workView. + + menuView subMenuAt:#undo put:menuUndo. + ^ menuView +! ! + +!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 interaction'! + +closeRequest + workView notNil ifTrue:[workView release. workView := nil]. + super closeRequest +! + +closeRequestFor:aTopView + aTopView == topView ifTrue:[ + super closeRequestFor:aTopView + ] ifFalse:[ + topView device beep + ] +! ! + +!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" +! + +doInstallAspects + |code| + + (specClass isNil or:[specSelector isNil]) ifTrue:[ + self defineClassAndSelector + ]. + + self checkClassAndSelector ifFalse:[ + ^ self + ]. + + workView className:specClass superclassName:specSuperclass selector:specSelector. + + code := workView generateAspectMethods. + (ReadStream on:code) fileIn. + + "Modified: 4.9.1995 / 17:06:10 / claus" +! + +doInstallSpec + |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. +! + +doOpen + |box| + + box := FileSelectionBox new. + box title:(resources string:'Which file ?'). + box selectingDirectory:false. + box pattern:'*.*'. + box action:[:aFile| self openFile:aFile ]. + box open +! + +doPickAView + |view className methodName cls sel accepted spec s| + + view := Display viewFromUser. + view isNil ifTrue:[^ self]. + + spec := UISpecification fromView:view topView. + + "/ 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 +! + +doRaise + workView topView raise +! + +doSave + fileName notNil ifTrue:[ + self saveAs:fileName + ] ifFalse:[ + self doSaveAs + ] +! + +doSaveAs + |box| + + box := FileSelectionBox new. + box title:(resources string:'Which file ?'). + box selectingDirectory:false. + box pattern:'*.*'. + box action:[:aFile| self saveAs:aFile ]. + box open +! ! + +!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'! + +doToggleTest + workView testMode:(workView testMode not) +! + +doWindowSpec + |code v| + + code := workView generateWindowSpecMethodSource. + code := code , workView generateAspectMethods. + v := CodeView open. + v contents:code. + v label:'windowSpec'. + ^ self + + "Modified: 5.9.1995 / 21:04:14 / claus" +! ! + +!UIPainter::ButtonPanel class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! + !UIPainter::ButtonPanel methodsFor:'accessing'! receiver @@ -114,3 +1091,8 @@ ^ menu ! ! +!UIPainter class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIPainterTreeView.st --- a/UIPainterTreeView.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIPainterTreeView.st Tue Feb 25 15:07:09 1997 +0100 @@ -10,6 +10,8 @@ hereby transferred. " +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:28 pm' ! + SelectionInListView subclass:#UIPainterTreeView instanceVariableNames:'builderView' classVariableNames:'' diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIPainterView.st --- a/UIPainterView.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIPainterView.st Tue Feb 25 15:07:09 1997 +0100 @@ -1,3 +1,25 @@ +" + 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. +" + +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:29 pm' ! + +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 defaultable menuSelector @@ -7,6 +29,1741 @@ 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:'copy & cut & paste'! + +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; not into the paste buffer (undo) + " + |text| + + self numberOfSelections ~~ 0 ifTrue:[ + text := self transactionTextFor:selection. + + undoHistory transaction:#cut text:text do:[ + super deleteSelection + ]. + ] +! + +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| + |view org| + + builder componentCreationHook:[:aView :aSpecification :aBuilder | + self createdComponent:aView forSpec:aSpecification builder:aBuilder. + ]. + builder applicationClass:(Smalltalk classNamed:className). + view := aSpec buildViewWithLayoutFor:builder in:frame. + + (frame bounds containsPoint:pasteOrigin) ifFalse:[ + self moveObject:view to:pasteOffset. + ] ifTrue:[ + self moveObject:view to:pasteOrigin + pasteOffset. + ]. + + view realize. + selection add:view. + 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 + +! ! + +!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 specClass basicNew supportsLabel 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 +! + +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 methodsFor:'generating output'! + +generateActionMethodFor:aspect spec:protoSpec inClass:targetClass + ^ ('!!' , targetClass name , ' methodsFor:''actions''!!\\' , + aspect , '\' , + ' "automatically generated by UIPainter ..."\' , + '\' , + ' "action to be added ..."\' , + ' Transcript showCR:''action for ' , aspect , ' ...''.\' , + '!! !!\\') withCRs +! + +generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass + ^ ('!!' , targetClass name , ' methodsFor:''aspects''!!\\' , + aspect , '\' , + ' "automatically generated by UIPainter ..."\' , + '\' , + ' |holder|\' , + '\' , + ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' , + ' builder aspectAt:#' , aspect , ' put:(holder := ' , ' ValueHolder new' , ').\' , + ' ].\' , + ' ^ holder\' , + '!! !!\\') withCRs +! + +generateAspectMethods + |cls code| + + className isNil ifTrue:[ + ^ self warn:'set the class first' + ]. + (cls := Smalltalk at:className asSymbol) isNil ifTrue:[ + ^ self warn:'create the class first' + ]. + + code := ''. + + viewProperties do:[:aProp | + |modelSelector protoSpec thisCode| + + (modelSelector := aProp aspectSelector) notNil ifTrue:[ + (cls implements:modelSelector asSymbol) ifFalse:[ + protoSpec := aProp view specClass basicNew. + "/ kludge .. + (protoSpec isMemberOf:ActionButtonSpec) ifTrue:[ + thisCode := (self generateActionMethodFor:modelSelector spec:protoSpec inClass:cls). + ] ifFalse:[ + thisCode := (self generateAspectMethodFor:modelSelector spec:protoSpec inClass:cls). + ]. + code := code , thisCode + ] + ] + ]. + ^ code + +! ! + +!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 defaultable + menuSelector initiallyInvisible| + + props := self propertyOfView:view. + props isNil ifTrue:[^ self]. + + (aspectSelector := props aspectSelector) notNil ifTrue:[ + newSpec model:aspectSelector + ]. + (changeSelector := props changeSelector) notNil ifTrue:[ + newSpec change:changeSelector + ]. + (menuSelector := props menuSelector) notNil ifTrue:[ + newSpec menu:menuSelector + ]. + (labelSelector := props labelSelector) notNil ifTrue:[ + newSpec label:labelSelector + ]. + (tabable := props tabable) notNil ifTrue:[ + newSpec tabable:tabable + ]. + (defaultable := props defaultable) notNil ifTrue:[ + newSpec defaultable:defaultable + ]. + (initiallyInvisible := props initiallyInvisible) notNil ifTrue:[ + newSpec initiallyInvisible:initiallyInvisible + ]. + (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" +! + +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 menuSelector:(aSpec menuSelector). + props tabable:(aSpec tabable). + props defaultable:(aSpec defaultable). + props initiallyInvisible:(aSpec initiallyInvisible). + + 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 + ] +! + +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:'menus'! + +menu + |menu canPaste| + + testMode ifTrue:[^ nil ]. + + canPaste := self canPaste:(self getSelection). + + selection isNil ifTrue:[ + menu := PopUpMenu labels:( resources array:#('paste' 'undo')) + selectors:#( #pasteBuffer #undoLast ) + accelerators:#( #Paste nil ) + receiver:self. + + canPaste ifFalse:[menu disable:#pasteBuffer]. + undoHistory isEmpty ifTrue:[menu disable:#undoLast]. + ^ 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. + + (canPaste 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:'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 + " + |spec prop| + + undoHistory isTransactionOpen ifTrue:[ + (prop := self propertyOfView:anObject) notNil ifTrue:[ + self undoRemove:(prop identifier) + ] + ]. + self removeTreeFrom:anObject. + self changed:#tree +! + +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:[ + viewProperties remove:props ifAbsent:nil + ]. + 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 +! + +findViewWithId:aViewId + "finds view assigned to id and returns the view or nil + " + |prop| + + prop := self propertyOfIdentifier:aViewId. + + prop notNil ifTrue:[^ prop view] + ifFalse:[^ nil] +! ! + +!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:anId + + anId notNil ifTrue:[ + ^ viewProperties detect:[:p| p identifier == anId] ifNone:nil. + ]. + ^ nil +! + +propertyOfName:aString + + aString = 'self' ifFalse:[ + ^ viewProperties detect:[:p| p name = aString] ifNone:nil + ]. + ^ nil +! + +propertyOfView:aView + + (aView isNil or:[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'! + +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. + size == 0 ifTrue:[^ nil]. + size ~~ 1 ifTrue:[^ size printString, ' elements']. + + props := self propertyOfView:(anElementOrCollection at:1). + ] ifFalse:[ + props := self propertyOfView:anElementOrCollection + ]. + props notNil ifTrue:[ ^ props name ] + ]. + ^ nil +! ! + +!UIPainterView methodsFor:'undo actions'! + +undoCreate:aViewId + |view| + + undoHistory addUndoBlock:[ + (view := self findViewWithId:aViewId) notNil ifTrue:[ + self removeObject:view + ] + ] + +! + +undoLayout:aViewId + "undo method layout + " + |view layout| + + (view := self findViewWithId:aViewId) notNil ifTrue:[ + layout := view geometryLayout copy. + view := nil. + + layout notNil ifTrue:[ + undoHistory addUndoBlock:[ + (view := self findViewWithId:aViewId) notNil ifTrue:[ + view geometryLayout:layout + ] + ] + ] ifFalse:[ + layout := view pixelOrigin. + + undoHistory addUndoBlock:[ + (view := self findViewWithId:aViewId) notNil ifTrue:[ + view pixelOrigin:layout + ] + ] + ] + ] +! + +undoLayoutView:aView + "undo method for changing layout on a view + " + |prop| + + undoHistory isTransactionOpen ifTrue:[ + prop := self propertyOfView:aView. + prop notNil ifTrue:[ + self undoLayout:(prop identifier) + ] + ] +! + +undoRemove:aViewId + "prepare undo method + " + |view prop spec parentId| + + (view := self findViewWithId:aViewId) notNil ifTrue:[ + spec := (self generateSpecFor:view) first. + view := view superView. + + (self supportsSubComponents:view) ifTrue:[ + prop := self propertyOfView:view. + + prop notNil ifTrue:[ + parentId := prop identifier + ] + ]. + view := nil. + prop := nil. + + undoHistory addUndoBlock:[ + |builder| + + builder := UIBuilder new. + view := self findViewWithId:parentId. + + view isNil ifTrue:[ + view := self + ]. + + builder componentCreationHook:[:aView :aSpec :aBuilder | + self createdComponent:aView forSpec:aSpec builder:aBuilder. + ]. + + builder applicationClass:(Smalltalk classNamed:className). + (spec buildViewWithLayoutFor:builder in:view) realize. + inputView raise. + ]. + ] +! + +undoSpecModify:aViewId + "undo for updateFromSpec + " + |builder view spec| + + (view := self findViewWithId:aViewId) notNil ifTrue:[ + spec := (self generateSpecFor:view) first. + view := nil. + + undoHistory addUndoBlock:[ + (view := self findViewWithId:aViewId) notNil ifTrue:[ + builder := UIBuilder new. + spec setAttributesIn:view with:builder. + view superView sizeChanged:nil + ] + ] + ]. + + + +! ! + +!UIPainterView methodsFor:'update from Specification'! + +updateFromSpec:aSpec + "update current selected view from specification + " + |props name builder| + + self singleSelection notNil ifTrue:[ + self selectionHiddenDo:[ + self transaction:#specification selectionDo:[:aView| + builder := UIBuilder new. + props := self propertyOfView:aView. + name := aSpec name. + + self undoSpecModify:(props identifier). + + name = (aView name) ifFalse:[ + name notNil ifTrue:[ + name := name withoutSeparators. + + (name isEmpty or:[(self propertyOfName:name) notNil]) ifTrue:[ + name := nil + ] + ]. + name isNil ifTrue:[ + aSpec name:(aView name). + ] + ]. + + aSpec setAttributesIn:aView with:builder. + aView superView sizeChanged:nil. + + props tabable:aSpec tabable. + props defaultable:aSpec defaultable. + props initiallyInvisible:aSpec initiallyInvisible. + props aspectSelector:aSpec modelSelector. + props changeSelector:aSpec changeSelector. + props labelSelector:aSpec labelSelector. + props menuSelector:aSpec menuSelector. + ]. + self changed:#tree + ] + ]. + +! ! + +!UIPainterView::ViewProperty class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! + !UIPainterView::ViewProperty class methodsFor:'instance creation'! new @@ -149,3 +1906,30 @@ 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 0a2b2ff030a0 -r 7542ab7fbbfe UIPropertyView.st --- a/UIPropertyView.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIPropertyView.st Tue Feb 25 15:07:09 1997 +0100 @@ -1,3 +1,5 @@ +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:33 pm' ! + ApplicationModel subclass:#UIPropertyView instanceVariableNames:'builderView modified propertyFrame propertyList propertySpecs currentView currentSpec propertyAspects staticAspects