"{ Package: 'stx:libtool2' }"
"{ NameSpace: Tools }"
HierarchicalItem subclass:#ViewTreeItem
instanceVariableNames:'widget isDrawnShown exists xOffsetApplClass'
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 paint applName|
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.
xOffsetApplClass notNil ifTrue:[
applName := self labelOfApplicationClass.
applName notNil ifTrue:[
self displayLabel:applName
h:labelHeight on:aGC
x:(x + xOffsetApplClass)
y:y
h:h.
].
].
!
labelOfApplicationClass
"answer the name of the underlaying application or nil"
|applClass|
self isApplicationClass ifTrue:[
applClass := self applicationClass.
applClass notNil ifTrue:[
^ ('[ ', applClass name, ' ]')
].
].
xOffsetApplClass := nil.
^ nil
!
widthOn:aGC
"return the width of the receiver, if it is to be displayed on aGC
"
|applName|
width isNil ifTrue:[
width := self widthOf:(self label) on:aGC.
width := width + 2.
applName := self labelOfApplicationClass.
applName notNil ifTrue:[
xOffsetApplClass := width + 10.
width := xOffsetApplClass + (self widthOf:applName 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!