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