--- a/Tools__ViewTreeItem.st Wed Feb 03 11:02:39 2010 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,823 +0,0 @@
-"{ Package: 'stx:libtool2' }"
-
-"{ NameSpace: Tools }"
-
-HierarchicalItem subclass:#ViewTreeItem
- instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
- 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'!
-
-additionalLabelForItem:anItem
- "answer an additional item for an Item or nil"
-
- parent notNil ifTrue:[
- ^ parent additionalLabelForItem:anItem
- ].
- ^ nil
-!
-
-displayIcon:anIcon atX:x y:y on:aGC
- |x0 y0 y1 w|
-
- super displayIcon:anIcon atX:x y:y on:aGC.
-
- self exists ifFalse:[
- aGC paint:(Color red).
-
- y0 := y + 1.
- y1 := y + anIcon height - 2.
-
- x0 := x - 1.
- w := anIcon width.
-
- 2 timesRepeat:[
- aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
- aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
- x0 := x0 + 1.
- ].
- ].
-!
-
-displayOn:aGC x:x y:y h:h
- |labelHeight additionalName label isValidAndShown|
-
- label := self label.
- label isEmptyOrNil ifTrue:[^ self].
-
- widget id isNil ifTrue:[
- isDrawnShown := false.
-
- self exists ifFalse:[
- xOffsetAdditionalName := nil.
- ].
- isValidAndShown := false.
- ] ifFalse:[
- isValidAndShown := widget shown.
- ].
- isValidAndShown ifFalse:[
- label := Text string:label emphasis:#italic
- ].
-
- labelHeight := self heightOn:aGC.
- self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
-
- xOffsetAdditionalName notNil ifTrue:[
- additionalName := self additionalLabelForItem:self.
-
- additionalName notNil ifTrue:[
- self displayLabel:additionalName
- h:labelHeight on:aGC
- x:(x + xOffsetAdditionalName)
- y:y
- h:h.
- ] ifFalse:[
- xOffsetAdditionalName := nil.
- ].
- ].
-!
-
-recursiveAdditionalNameBehaviourChanged
- width := xOffsetAdditionalName := nil.
-
- children notNil ifTrue:[
- children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
- ].
-!
-
-widthOn:aGC
- "return the width of the receiver, if it is to be displayed on aGC
- "
- |additionalName|
-
- width isNil ifTrue:[
- width := self widthOf:(self label) on:aGC.
- width := width + 2.
-
- additionalName := self additionalLabelForItem:self.
-
- additionalName notNil ifTrue:[
- xOffsetAdditionalName := width + 10.
- width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
- width := width + 2.
- ] ifFalse:[
- xOffsetAdditionalName := nil.
- ].
- ].
- ^ 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!