--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ViewTreeItem.st Fri Sep 21 13:45:40 2007 +0200
@@ -0,0 +1,764 @@
+"{ Package: 'stx:libtool2' }"
+
+"{ NameSpace: Tools }"
+
+HierarchicalItem subclass:#ViewTreeItem
+ instanceVariableNames:'widget isDrawnShown exists'
+ classVariableNames:'HandleExtent'
+ poolDictionaries:''
+ category:'A-Views-Support'
+!
+
+!ViewTreeItem class methodsFor:'documentation'!
+
+documentation
+"
+ ViewTreeItems represants a pickable object within a ViewTreeModel.
+ The class is used to build up the hierarchical tree.
+
+ [Instance variables:]
+ widget <View> the widget represented by the item
+ spec <UISpecification> the UISpecification or nil
+
+ [Class variables:]
+ HandleExtent <Point> keeps the extent of a handle
+
+
+ [author:]
+ Claus Atzkern
+
+ [see also:]
+ HierarchicalItem
+ ViewTreeModel
+"
+! !
+
+!ViewTreeItem class methodsFor:'initialization'!
+
+initialize
+ "set the extent of the Handle
+ "
+ HandleExtent := 6@6.
+! !
+
+!ViewTreeItem class methodsFor:'instance creation'!
+
+forView:aView
+ |item|
+
+ item := self basicNew initialize.
+ item forView:aView.
+ ^ item
+!
+
+new
+ self error:'not allowed'.
+ ^ nil
+!
+
+on:aView withSpec:aSpec
+ |item|
+
+ item := self basicNew initialize.
+ item on:aView withSpec:aSpec.
+ ^ item
+! !
+
+!ViewTreeItem class methodsFor:'building'!
+
+buildViewsFrom:aView
+ "build the items starting from a source view;
+ returns the anhor.
+ "
+ |item subViews subItems|
+
+ aView isNil ifTrue:[^ nil].
+
+ item := self forView:aView.
+ subViews := aView subViews.
+
+ subViews notEmptyOrNil ifTrue:[
+ subItems := OrderedCollection new.
+ subViews do:[:aSubView|
+ subItems add:(self buildViewsFrom:aSubView).
+ ].
+ item children:subItems.
+ ].
+ ^ item
+! !
+
+!ViewTreeItem methodsFor:'accessing'!
+
+applicationClass
+ |appl|
+
+ widget notNil ifTrue:[
+ appl := widget application.
+ appl notNil ifTrue:[^ appl class ].
+ ].
+ ^ nil
+!
+
+isDrawnShown
+ "returns true if the last display operations was done during the widget was shown
+ "
+ ^ isDrawnShown
+!
+
+isDrawnShown:aBoolean
+ isDrawnShown := aBoolean.
+!
+
+rootView
+ "returns the widget assigned to the root or nil
+ "
+ ^ parent rootView
+!
+
+specClass
+ "returns the spec-class assigned to the item
+ "
+ ^ widget specClass
+!
+
+treeModel
+ "returns the assigned treeModel, an instance of ViewTreeModel
+ "
+ ^ parent treeModel
+!
+
+widget
+ "returns the widget assigned to the item
+ "
+ ^ widget
+! !
+
+!ViewTreeItem methodsFor:'accessing layout'!
+
+boundsRelativeToRoot
+ "returns the bounds relative to the root widget
+ "
+ ^ self originRelativeToRoot extent:(widget extent)
+!
+
+cornerRelativeToRoot
+ "returns the corner relative to the root widget
+ "
+ ^ self originRelativeToRoot + (widget extent)
+!
+
+extent
+ "returns the extent of the widget
+ "
+ ^ widget extent
+!
+
+layoutType
+ "returns the type of layout assigned to the wiget; nil if the
+ superView cannot resize its sub widgets
+ "
+ |layout specClass superView|
+
+ (superView := widget superView) isNil ifTrue:[
+ ^ #Extent
+ ].
+
+ specClass := superView specClass.
+
+ (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
+ ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
+ ].
+
+ (layout := widget geometryLayout) isNil ifTrue:[
+ ^ #Extent
+ ].
+
+ layout isLayout ifTrue:[
+ layout isLayoutFrame ifTrue:[ ^ #LayoutFrame ].
+ layout isAlignmentOrigin ifTrue:[ ^ #AlignmentOrigin ].
+ layout isLayoutOrigin ifTrue:[ ^ #LayoutOrigin ].
+ ] ifFalse:[
+ layout isRectangle ifTrue:[ ^ #Rectangle ].
+ layout isPoint ifTrue:[ ^ #Point ].
+
+ ].
+ Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
+ ^ nil
+!
+
+originRelativeToRoot
+ "returns the origin relative to the root widget
+ "
+ ^ widget originRelativeTo:(self rootView)
+! !
+
+!ViewTreeItem methodsFor:'accessing optimize'!
+
+children
+ "redefined: optimize
+ "
+ ^ children
+!
+
+hasChildren
+ |subViews list item|
+
+ children size ~~ 0 ifTrue:[
+ ^ true
+ ].
+ isExpanded := false.
+ subViews := widget subViews.
+
+ subViews size == 0 ifTrue:[^ false].
+
+ list := OrderedCollection new.
+
+ subViews do:[:aSubView|
+ item := self class buildViewsFrom:aSubView.
+ item parent:self.
+ list add:item.
+ ].
+ children := list.
+ ^ true
+!
+
+size
+ "redefined: returns list of children
+ "
+ ^ children size
+! !
+
+!ViewTreeItem methodsFor:'displaying'!
+
+displayOn:aGC x:x y:y h:h
+ |labelHeight applClass paint|
+
+ widget id isNil ifTrue:[
+ isDrawnShown := false.
+ self exists ifFalse:[^ self].
+ paint := Color white.
+ ] ifFalse:[
+ isDrawnShown := widget shown.
+ paint := isDrawnShown ifTrue:[Color black] ifFalse:[Color darkGray].
+ ].
+ aGC paint:paint.
+
+ labelHeight := self heightOn:aGC.
+ self displayLabel:(self label) h:labelHeight on:aGC x:x y:y h:h.
+
+ self isApplicationClass ifTrue:[
+ aGC paint:(Color black).
+ applClass := self applicationClass.
+
+ applClass notNil ifTrue:[
+ self displayLabel:('[ ', applClass name, ' ]')
+ h:labelHeight on:aGC
+ x:(x + 10 + (self widthOn:aGC))
+ y:y
+ h:h.
+ ].
+ ].
+!
+
+widthOn:aGC
+ "return the width of the receiver, if it is to be displayed on aGC
+ "
+ width isNil ifTrue:[
+ width := self widthOf:(self label) on:aGC.
+ width := width + 2.
+ ].
+ ^ width
+! !
+
+!ViewTreeItem methodsFor:'enumerating'!
+
+handlesDo:aTwoArgAction
+ "evaluate the two arg block on each handle; the arguments to the block is
+ the rectangle relative to the rootView and the handle type which is
+ set to nil if not resizeable.
+
+ TYPES: type position( X - Y )
+ -------------------------
+ #LT Left - Top
+ #LC Left - Center
+ #LB Left - Bottom
+ #CT Center - Top
+ #CB Center - Bottom
+ #RT Right - Top
+ #RC Right - Center
+ #RB Right - Bottom
+
+ nil ** handle not pickable **
+ "
+ |type relOrg relCrn maxExt rootView w h
+ xL "{ Class:SmallInteger }"
+ xC "{ Class:SmallInteger }"
+ xR "{ Class:SmallInteger }"
+ yT "{ Class:SmallInteger }"
+ yC "{ Class:SmallInteger }"
+ yB "{ Class:SmallInteger }"
+ |
+ rootView := self rootView.
+ relOrg := widget originRelativeTo:rootView.
+ relOrg isNil ifTrue:[ ^ self ]. "/ widget destroyed
+
+ relOrg := relOrg - (HandleExtent // 2).
+ relCrn := relOrg + widget extent.
+ maxExt := rootView extent - HandleExtent.
+
+ xL := relOrg x max:0.
+ xR := relCrn x min:(maxExt x).
+ xC := xR + xL // 2.
+
+ yT := relOrg y max:0.
+ yB := relCrn y min:(maxExt y).
+ yC := yB + yT // 2.
+
+ type := self layoutType.
+ w := HandleExtent x.
+ h := HandleExtent y.
+
+ (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
+ aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
+ aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
+ aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
+ aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
+ aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
+ aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
+ aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
+ aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
+ ^ self
+ ].
+
+ aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
+ aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
+ aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
+
+ type == #Extent ifTrue:[
+ aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
+ aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
+ aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
+ ^ self
+ ].
+ aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
+!
+
+recursiveEachVisibleItemDo:anOneArgBlock
+ "recursive evaluate the block on each child which is visible
+ "
+ (isExpanded and:[children size > 0]) ifTrue:[
+ children do:[:aChild|
+ anOneArgBlock value:aChild.
+ aChild recursiveEachVisibleItemDo:anOneArgBlock.
+ ]
+ ].
+!
+
+subViewsDo:aOneArgBlock
+ "evaluate aBlock for all subviews other than InputView's
+ "
+ |subViews|
+
+ subViews := widget subViews.
+
+ subViews notNil ifTrue:[
+ subViews do:aOneArgBlock
+ ].
+! !
+
+!ViewTreeItem methodsFor:'initialization'!
+
+forView:aView
+ widget := aView.
+!
+
+initialize
+ "setup default attributes
+ "
+ super initialize.
+ isDrawnShown := false.
+ isExpanded := false.
+ children := OrderedCollection new.
+! !
+
+!ViewTreeItem methodsFor:'operations delete'!
+
+delete
+ "delete self and all contained items; the assigned views are destroyed
+ in case of rootView, only the children are deleted
+ "
+ parent isHierarchicalItem ifTrue:[
+ self criticalDo:[
+ parent remove:self.
+ widget destroy.
+ ]
+ ] ifFalse:[
+ self deleteAll
+ ].
+!
+
+deleteAll
+ "delete all contained items; the assigned views are destroyed
+ "
+ children size == 0 ifTrue:[^ self].
+
+ self criticalDo:[
+ self nonCriticalDo:[:el| el widget destroy ].
+ self removeAll
+ ].
+! !
+
+!ViewTreeItem methodsFor:'operations layout'!
+
+asLayoutFrame
+ "convert the layout of the widget to a LayoutFrame;
+ "
+ |extent layout newLyt lftFrc lftOff topFrc topOff|
+
+ layout := widget geometryLayout.
+
+ layout isNil ifTrue:[
+ ^ widget bounds asLayout
+ ].
+
+ layout isLayout ifFalse:[
+ layout isRectangle ifTrue:[
+ ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
+ topOffset:(layout top) bottomOffset:(layout bottom)
+ ].
+ layout isPoint ifTrue:[
+ extent := widget extent.
+ ^ LayoutFrame leftOffset:(layout x) rightOffset:(layout x + extent x)
+ topOffset:(layout y) bottomOffset:(layout y + extent y)
+ ].
+
+ Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
+ ^ nil
+ ].
+
+ layout isLayoutFrame ifTrue:[ ^ layout copy ].
+
+ lftFrc := layout leftFraction.
+ lftOff := layout leftOffset.
+ topFrc := layout topFraction.
+ topOff := layout topOffset.
+ extent := widget extent.
+
+ newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
+ rightFraction:lftFrc offset:(lftOff + extent x)
+ topFraction:topFrc offset:topOff
+ bottomFraction:topFrc offset:(topOff + extent y).
+
+ ( layout isAlignmentOrigin
+ and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
+ ) ifTrue:[
+ |svRc prBd dlta|
+
+ svRc := widget superView viewRectangle.
+ prBd := widget preferredBounds.
+
+ dlta := ( ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
+ - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
+ ) rounded.
+
+ newLyt leftOffset:(lftOff + dlta x).
+ newLyt rightOffset:(lftOff + extent x + dlta x).
+ newLyt topOffset:(topOff + dlta y).
+ newLyt bottomOffset:(topOff + extent y + dlta y).
+ ].
+ ^ newLyt
+!
+
+moveLeft:l top:t
+ "move the widget n pixele left and right
+ "
+ |layout|
+
+ self isMoveable ifFalse:[ ^ self ].
+
+ (layout := widget geometryLayout) isNil ifTrue:[
+ "Extent"
+ widget origin:(widget origin + (l@t)).
+ ^ self
+ ].
+
+ layout := layout copy.
+
+ layout isLayout ifTrue:[
+ layout leftOffset:(layout leftOffset + l)
+ topOffset:(layout topOffset + t).
+
+ layout isLayoutFrame ifTrue:[
+ layout rightOffset:(layout rightOffset + l).
+ layout bottomOffset:(layout bottomOffset + t).
+ ]
+
+ ] ifFalse:[
+ layout isRectangle ifTrue:[
+ layout setLeft:(layout left + l).
+ layout setTop:(layout top + t).
+ ] ifFalse:[
+ layout isPoint ifFalse:[^ self].
+ layout x:(layout x + l) y:(layout y + t).
+ ]
+ ].
+ widget geometryLayout:layout.
+!
+
+resizeLeft:l top:t right:r bottom:b
+ "resize the widget measured in pixels
+ "
+ |layout|
+
+ self isResizeable ifFalse:[
+ ^ self
+ ].
+
+ (layout := widget geometryLayout) isNil ifTrue:[
+ "Extent"
+ (r == l and:[b == t]) ifFalse:[
+ widget extent:(widget computeExtent + ((r-l) @ (b-t))).
+ ].
+ ^ self
+ ].
+
+ layout isLayout ifTrue:[
+ layout := layout copy.
+
+ layout leftOffset:(layout leftOffset + l)
+ topOffset:(layout topOffset + t).
+
+ layout isLayoutFrame ifTrue:[
+ layout bottomOffset:(layout bottomOffset + b).
+ layout rightOffset:(layout rightOffset + r).
+ ]
+ ] ifFalse:[
+ layout isRectangle ifFalse:[^ self].
+ layout := layout copy.
+
+ layout left:(layout left + l)
+ right:(layout right + r)
+ top:(layout top + t)
+ bottom:(layout bottom + b).
+ ].
+ widget geometryLayout:layout.
+! !
+
+!ViewTreeItem methodsFor:'operations update'!
+
+updateChildren
+ |list|
+
+ self do:[:el|
+ el exists ifTrue:[
+ el updateChildren.
+ ] ifFalse:[
+ list isNil ifTrue:[list := OrderedCollection new].
+ list add:el.
+ ]
+ ].
+ list notNil ifTrue:[
+ list do:[:el| self remove:el ].
+ ].
+!
+
+updateFromChildren:mergedList
+ "update my children against the list of items derived from
+ the merged list.
+ "
+
+ mergedList size == 0 ifTrue:[ ^ self removeAll ].
+ children size == 0 ifTrue:[ ^ self addAll:mergedList ].
+
+ self criticalDo:[
+ self nonCriticalDo:[:el| |wdg|
+ wdg := el widget.
+ mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
+ ].
+
+ mergedList keysAndValuesDo:[:i :el| |wdg e2|
+ wdg := el widget.
+
+ e2 := self at:i ifAbsent:nil.
+
+ (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
+ self add:el beforeIndex:i
+ ]
+ ]
+ ].
+! !
+
+!ViewTreeItem methodsFor:'printing & storing'!
+
+icon
+ "get the icon used for presentation
+ "
+ |specClass model|
+
+ specClass := self specClass.
+ specClass isNil ifTrue:[^ nil].
+
+ model := self treeModel.
+
+ model notNil ifTrue:[
+ ^ model iconAt:specClass ifNonePut:[specClass icon]
+ ].
+ ^ specClass icon
+!
+
+label
+ "get the label used for presentation
+ "
+ ^ self string
+!
+
+printOn:aStream
+ "append a a printed representation of the item to aStream
+ "
+ aStream nextPutAll:(self string)
+!
+
+string
+ "get the string
+ "
+ ^ widget class name.
+! !
+
+!ViewTreeItem methodsFor:'queries'!
+
+canChangeLayout
+ "returns true if the layout of the widget can be changed and the
+ layout is not organized by its superView
+ "
+ ^ self isResizeable
+!
+
+canResizeSubComponents
+ "returns true if the widget can resize its sub components
+ "
+ |specClass|
+
+ specClass := self specClass.
+
+ specClass notNil ifTrue:[
+ ^ specClass canResizeSubComponents
+ ].
+ ^ false
+!
+
+exists
+ widget id notNil ifTrue:[^ true ].
+
+ exists ~~ false ifTrue:[
+ exists := false.
+
+ widget superView notNil ifTrue:[
+ (parent isHierarchicalItem and:[parent exists]) ifTrue:[
+ exists := (parent widget subViews includesIdentical:widget).
+ ].
+ ].
+ ].
+ ^ exists
+!
+
+isApplicationClass
+ |cls|
+
+ cls := widget class.
+
+ ^ ( cls == ApplicationSubView
+ or:[cls == ApplicationWindow
+ or:[cls == SubCanvas]]
+ )
+!
+
+isSelected
+ |model|
+
+ model := self treeModel.
+ model notNil ifTrue:[^ model isSelected:self].
+ ^ false
+!
+
+supportsSubComponents
+ "returns true if the widget supports sub components
+ "
+ |specClass|
+
+ widget isScrollWrapper ifTrue:[
+ ^ false
+ ].
+ specClass := self specClass.
+
+ specClass notNil ifTrue:[
+ ^ specClass supportsSubComponents
+ ].
+ ^ false
+! !
+
+!ViewTreeItem methodsFor:'testing'!
+
+isInLayoutContainer
+ "returns true if the widget is in a layout container
+ "
+ |sv specClass|
+
+ sv := widget superView.
+
+ sv notNil ifTrue:[
+ specClass := sv specClass.
+
+ specClass notNil ifTrue:[
+ ^ specClass isLayoutContainer
+ ].
+ ].
+ ^ false
+!
+
+isLayoutContainer
+ "answer whether corresponding view instances of the spec class can contain
+ (and arrange) other view
+ "
+ |specClass|
+
+ specClass := self specClass.
+
+ specClass notNil ifTrue:[
+ ^ specClass isLayoutContainer
+ ].
+ ^ false
+!
+
+isMoveable
+ "returns true if the widget is not in a layout container
+ "
+ self isInLayoutContainer ifFalse:[
+ ^ widget superView notNil
+ ].
+ ^ false
+!
+
+isResizeable
+ "returns true if the widget is resizeable
+ "
+ |sv specClass|
+
+ sv := widget superView.
+
+ sv notNil ifTrue:[
+ specClass := sv specClass.
+
+ specClass notNil ifTrue:[
+ ^ specClass canResizeSubComponents
+ ].
+ ].
+ ^ false
+! !
+
+!ViewTreeItem class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !
+
+ViewTreeItem initialize!