"{ Package: 'stx:libtool2' }"
"{ NameSpace: Tools }"
ApplicationModel subclass:#ViewTreeApplication
instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
motionAction process followFocusChannel showNamesHolder'
classVariableNames:''
poolDictionaries:''
category:'A-Views-Support'
!
Object subclass:#MenuDesc
instanceVariableNames:'title value action'
classVariableNames:''
poolDictionaries:''
privateIn:ViewTreeApplication
!
!ViewTreeApplication class methodsFor:'documentation'!
documentation
"
Small application showing a ViewTreeModel use.
It displays a hierarchical list of a selected TopView and
all its contained subViews.
Useful to have a look at subcomponents - to see how views
are structured.
[Instance variables:]
model <ViewTreeModel> the used ViewTreeModel
clickedItem <ViewTreeItem> item under the clickedPoint (motion action)
clickedPoint <Point> point where the motion action started from.
motionAction <Action> (oneArg-) action called durring buttonMotion.
[author:]
Claus Atzkern
[see also:]
ViewTreeModel
ViewTreeItem
"
! !
!ViewTreeApplication class methodsFor:'initialization'!
initialize
"add myself to the launcher menu
"
self installInLauncher.
!
installInLauncher
"add myself to the launcher menu
"
|menuItem icon|
NewLauncher isNil ifTrue:[^ self].
icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
menuItem := MenuItem new
label: 'View Inspector';
value: [ ViewTreeApplication open];
isButton: true;
icon: icon;
nameKey: #viewInspect.
menuItem startGroup:#right.
NewLauncher addMenuItem:menuItem in:'toolbar'
position:#( #before #help)
space:false.
"
self installInLauncher
self removeFromLauncher
"
!
postAutoload
"add myself to the launcher menu
"
self installInLauncher.
"
self installInLauncher
self removeFromLauncher
"
!
removeFromLauncher
"remove myself from the launcher menu
"
NewLauncher isNil ifTrue:[^ self].
NewLauncher removeUserTool:#viewInspect
"
self installInLauncher
self removeFromLauncher
"
!
unload
"class is about to be unloaded - remove myself from the launcher menu
"
self removeFromLauncher.
super unload.
! !
!ViewTreeApplication class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::ViewTreeApplication andSelector:#windowSpec
Tools::ViewTreeApplication new openInterface:#windowSpec
Tools::ViewTreeApplication open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'ViewTreeInspector'
name: 'ViewTreeInspector'
min: (Point 10 10)
max: (Point 1024 9999)
bounds: (Rectangle 0 0 381 654)
menu: menu
)
component:
(SpecCollection
collection: (
(MenuPanelSpec
name: 'toolbarMenu'
layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)
menu: toolbarMenu
textDefault: true
)
(HierarchicalListViewSpec
name: 'List'
layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 0 1.0)
level: 1
model: model
menu: middleButtonMenu
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
miniScrollerHorizontal: true
miniScrollerVertical: false
listModel: listOfItems
multipleSelectOk: true
useIndex: false
highlightMode: label
showLeftIndicators: false
indicatorSelector: indicatorClicked:
useDefaultIcons: false
postBuildCallback: postBuildTree:
)
)
)
)
! !
!ViewTreeApplication class methodsFor:'menu specs'!
menu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
(Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'File'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Pick a View'
itemValue: doPickViews
translateLabel: true
)
(MenuItem
enabled: hasTargetWidgetChannel
label: 'Release Picked View'
itemValue: doUnpick
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Exit'
itemValue: closeRequest
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Settings'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Test Mode'
translateLabel: true
hideMenuOnActivated: false
indication: testModeChannel
)
(MenuItem
enabled: testModeChannel
label: 'Follow Focus'
translateLabel: true
hideMenuOnActivated: false
indication: followFocusChannel
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Select on Click'
translateLabel: true
hideMenuOnActivated: false
indication: selectOnClickHolder
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Show Name of Widgets'
translateLabel: true
hideMenuOnActivated: false
indication: showNamesHolder
)
)
nil
nil
)
)
(MenuItem
label: ''
)
(MenuItem
enabled: hasSingleSelectionHolder
label: 'Menu'
translateLabel: true
submenuChannel: middleButtonMenu
)
(MenuItem
enabled: hasTargetWidgetChannel
label: 'Components'
translateLabel: true
startGroup: right
submenuChannel: submenuComponents:
)
(MenuItem
enabled: hasTargetWidgetChannel
label: 'Applications'
translateLabel: true
submenuChannel: submenuApplications:
)
)
nil
nil
)
!
middleButtonMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
(Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Geometry'
translateLabel: true
submenuChannel: submenuGeometry:
keepLinkedMenu: true
)
(MenuItem
label: 'Interface'
translateLabel: true
submenuChannel: submenuInterface:
keepLinkedMenu: true
)
(MenuItem
label: 'Visibility'
translateLabel: true
submenuChannel: submenuVisibility:
keepLinkedMenu: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Browse View Class'
itemValue: doBrowse:
translateLabel: true
argument: view
)
(MenuItem
label: 'Browse Model Class'
itemValue: doBrowse:
translateLabel: true
isVisible: hasModel
argument: model
)
(MenuItem
label: 'Browse Application Class'
itemValue: doBrowse:
translateLabel: true
isVisible: hasApplication
argument: application
)
(MenuItem
label: 'Browse Controller Class'
itemValue: doBrowse:
translateLabel: true
isVisible: hasController
argument: controller
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Inspect View'
itemValue: doInspect:
translateLabel: true
argument: view
)
(MenuItem
label: 'Inspect Window Group'
itemValue: doInspect:
translateLabel: true
argument: group
)
(MenuItem
label: 'Inspect Model'
itemValue: doInspect:
translateLabel: true
isVisible: hasModel
argument: model
)
(MenuItem
label: 'Inspect Application'
itemValue: doInspect:
translateLabel: true
isVisible: hasApplication
argument: application
)
(MenuItem
label: 'Inspect Controller'
itemValue: doInspect:
translateLabel: true
isVisible: hasController
argument: controller
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Flash'
itemValue: doFlash
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Destroy'
itemValue: doDestroy
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Instance Variables'
translateLabel: true
submenuChannel: submenuInspector:
keepLinkedMenu: true
)
(MenuItem
label: '='
)
(MenuItem
label: ''
)
(MenuItem
enabled: selectedComponentHasChildren
label: 'Applications'
nameKey: single
translateLabel: true
submenuChannel: submenuApplications:
keepLinkedMenu: true
)
(MenuItem
enabled: selectedComponentHasChildren
label: 'Components'
nameKey: single
translateLabel: true
submenuChannel: submenuComponents:
keepLinkedMenu: true
)
)
nil
nil
)
!
toolbarMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#toolbarMenu
(Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication toolbarMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
enabled: hasSingleSelectionHolder
label: 'Application'
itemValue: doBrowse:
translateLabel: false
labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
argument: application
)
(MenuItem
enabled: hasSingleSelectionHolder
label: 'Application'
itemValue: doInspect:
translateLabel: false
labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
argument: application
)
(MenuItem
label: ''
)
(MenuItem
enabled: hasSingleSelectionHolder
label: 'Widget'
itemValue: doBrowse:
translateLabel: false
labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
argument: view
)
(MenuItem
enabled: hasSingleSelectionHolder
label: 'Widget'
itemValue: doInspect:
translateLabel: true
labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Widget')
argument: view
)
)
nil
nil
)
! !
!ViewTreeApplication methodsFor:'actions'!
indicatorClicked:anIndex
|item sensor|
item := model listOfItems at:anIndex ifAbsent:nil.
item notNil ifTrue:[
( (sensor := self window sensor) notNil
and:[(sensor ctrlDown or:[sensor shiftDown])]
) ifTrue:[
item recursiveToggleExpand
] ifFalse:[
item toggleExpand
]
].
! !
!ViewTreeApplication methodsFor:'aspects'!
followFocusChannel
"boolean holder, which indicates whether selection changed dependend on the focus view"
^ followFocusChannel
!
hasSingleSelectionHolder
"boolean holder, true if one item is selected"
^ hasSingleSelectionHolder
!
hasTargetWidgetChannel
"answer the channel which is set to true if a target widget exists"
^ model hasTargetWidgetChannel
!
listOfItems
"returns the hierarchical list of items"
^ model listOfItems
!
model
"returns my selection model, a ViewTreeModel"
^ model
!
selectOnClickHolder
"boolean holder, which indicates whether the selection will change on click"
^ model selectOnClickHolder
!
showNamesHolder
"boolean holder, which indicates whether application names or widget names
as additional text are shown for the items"
^ showNamesHolder
!
testModeChannel
"answer a boolean channel which describes the behaviour how to process
events on the target view.
false: all input events are eaten and the selection is shown on the target view.
true: no input events are eaten and no selection is shown on the target view."
^ model testModeChannel
! !
!ViewTreeApplication methodsFor:'change & update'!
selectionChanged
"called if the selection changed"
|info view item|
item := model selectedItem.
item notNil ifTrue:[ |state|
view := item widget.
view id isNil ifTrue:[
state := 'no ID'.
] ifFalse:[
view shown ifTrue:[
state := 'visible'.
] ifFalse:[
state := 'invisible'
].
].
info := '%1 [%2] - %3' bindWith:(view class name)
with:(view name ? '') with:state allBold.
] ifFalse:[
info := ''
].
hasSingleSelectionHolder value:(view notNil).
!
update:something with:someArgument from:aModel
|oldSelection|
aModel == showNamesHolder ifTrue:[
oldSelection := model selectedItem.
model selectedItem:nil.
self listOfItems showWidgetNames:(aModel value).
model selectedItem:oldSelection.
^ self
].
aModel == model ifTrue:[
self selectionChanged.
^ self
].
super update:something with:someArgument from:aModel.
! !
!ViewTreeApplication methodsFor:'event processing'!
processButtonMotionEvent:ev
"handle a button motion event"
|click rootView|
motionAction isNil ifTrue:[^ self].
(rootView := model rootView) isNil ifTrue:[
clickedItem := motionAction := nil.
^ self
].
click := rootView device
translatePoint:((ev x)@ (ev y))
fromView:(ev view)
toView:rootView.
click = clickedPoint ifFalse:[
(clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
motionAction value:click
]
].
!
processButtonPressEvent:ev
"handle a buttopn press event"
|rootView sensor lastRectangle|
rootView := model rootView.
sensor := model rootView sensor.
clickedItem := model listOfItems detectItemRespondsToView:(ev view).
(sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
clickedItem notNil ifTrue:[
self selectOnClickHolder value ifTrue:[
model toggleSelectItem:clickedItem
].
].
clickedItem := motionAction := nil.
^ self
].
clickedPoint := rootView device translatePoint:((ev x)@ (ev y)) fromView:(ev view) toView:rootView.
lastRectangle := nil.
motionAction :=[:p|
rootView := model rootView device rootView.
rootView := model rootView.
clickedItem := nil.
rootView xoring:[
lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
ifFalse:[ rootView clippedByChildren:false ].
p isNil ifTrue:[
rootView clippedByChildren:true.
motionAction := nil.
] ifFalse:[
lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
rootView displayRectangle:lastRectangle.
].
rootView flush.
].
lastRectangle
].
!
processButtonReleaseEvent:anEvent
"handle a button release event"
|rootView rectangle newItems widget origin|
(rootView := model rootView) isNil ifTrue:[
clickedItem := motionAction := nil.
^ self
].
motionAction isNil ifTrue:[ ^ self ].
clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
rectangle := motionAction value:nil.
rectangle isNil ifTrue:[^ self].
newItems := OrderedCollection new.
model rootItem recursiveDo:[:anItem|
widget := anItem widget.
origin := widget originRelativeTo:rootView.
(rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
newItems add:anItem.
]
].
model value:newItems.
!
processEvent:anEvent
"process an event"
|button menu|
anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
anEvent isButtonEvent ifFalse:[ ^ self ].
button := anEvent button.
(button == 2 or:[button == #menu]) ifTrue:[
motionAction isNil ifTrue:[
anEvent isButtonPressEvent ifTrue:[
self selectOnClickHolder value ifTrue:[
menu := self middleButtonMenu value.
menu notNil ifTrue:[
menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
receiver:self.
menu startUp.
]
].
].
clickedItem := nil.
].
^ self
].
anEvent isButtonPressEvent ifTrue:[ ^ self processButtonPressEvent:anEvent ].
anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].
anEvent isButtonReleaseEvent ifTrue:[
self selectOnClickHolder value ifTrue:[
self processButtonReleaseEvent:anEvent
].
].
clickedItem := motionAction := nil.
anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
self selectOnClickHolder value ifTrue:[
self doInspect:#view.
].
].
!
processKeyPressEvent:anEvent
"process an key press event"
|item prnt idx key max next|
key := anEvent key.
key isSymbol ifFalse:[^ self].
key == #Delete ifTrue:[ ^ self doDestroy ].
key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
( key == #CursorUp
or:[key == #CursorDown
or:[key == #CursorLeft
or:[key == #CursorRight]]]
) ifFalse:[
^ self
].
item := model selectedItem.
item isNil ifTrue:[
^ model selectedItem:(model first ? model rootItem)
].
prnt := item parent.
prnt isNil ifTrue:[
"/ is the root item
(key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
ifFalse:[item := item at:1 ifAbsent:item].
^ model selectedItem:item
].
key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
key == #CursorRight ifTrue:[
next := item at:1 ifAbsent:nil.
next notNil ifTrue:[ model selectedItem:next ].
^ self
].
max := prnt size.
key == #CursorUp ifTrue:[
idx := prnt identityIndexOf:item.
idx == 1 ifTrue:[idx := max + 1].
model selectedItem:(prnt at:idx - 1).
^ self.
].
key == #CursorDown ifTrue:[
idx := prnt identityIndexOf:item.
idx == max ifTrue:[idx := 0].
model selectedItem:(prnt at:idx + 1).
^ self.
].
!
processMappedView:aView
"process a mapped event"
|parent anchor|
parent := self listOfItems detectItemRespondsToView:aView.
parent isNil ifTrue:[ ^ self ].
NotFoundSignal handle:[:ex|
"contained subvies used by spec are not yet created;
thus we have to wait until last used subview is build
"
anchor := nil.
] do:[
anchor := parent class buildViewsFrom:(parent widget).
].
anchor notNil ifTrue:[
parent updateFromChildren:anchor children.
].
! !
!ViewTreeApplication methodsFor:'initialization & release'!
closeDownViews
"release the grapped application"
process := nil.
super closeDownViews.
self doUnpick.
!
initialize
"setup my model and channels"
super initialize.
hasSingleSelectionHolder := false asValue.
followFocusChannel := false asValue.
model := ViewTreeModel new.
model inputEventAction:[:ev| self processEvent:ev ].
model mappedViewAction:[:vw| self processMappedView:vw ].
model application:self.
model addDependent:self.
showNamesHolder := false asValue.
showNamesHolder addDependent:self.
!
postBuildTree:aTree
treeView := aTree scrolledView.
treeView hasConstantHeight:true.
! !
!ViewTreeApplication methodsFor:'menu queries'!
hasApplication
"returns true if the current selected view has an application"
|view|
view := self selectedView.
^ (view notNil and:[view application notNil])
!
hasController
"returns true if the current selected item's view has a controller
other than nil or the view itself"
|view controller|
view := self selectedView.
view notNil ifTrue:[
controller := view controller.
^ (controller notNil and:[controller ~~ view])
].
^ false
!
hasModel
"returns true if the current selected view has a model"
|view|
view := self selectedView.
^ (view notNil and:[view model notNil])
! !
!ViewTreeApplication methodsFor:'menu specs'!
middleButtonMenu
"returns the middleButton menu for the single selected item or nil"
^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
ifFalse:[nil]
]
!
submenuApplications:aMenu
|applications menu item list addBlock|
item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ifFalse:[model rootItem].
item isNil ifTrue:[^ nil].
applications := IdentityDictionary new.
addBlock := [:el| |cls ctr|
cls := self resolveApplicationClassFor:el.
cls notNil ifTrue:[
ctr := applications at:cls ifAbsent:0.
applications at:cls put:(ctr + 1).
].
].
item recursiveDo:addBlock.
addBlock value:item.
applications isEmpty ifTrue:[^ nil ].
list := SortedCollection sortBlock:[:a :b| a title < b title ].
applications keysAndValuesDo:[:cls :ctr|
list add:(MenuDesc title:(cls name)
value:(ctr printString)
action:[self doSelectNextOfApplicationClass:cls startingIn:item]
).
].
menu := MenuDesc buildFromList:list onGC:aMenu.
menu do:[:el|
el hideMenuOnActivated:false
].
^ menu
!
submenuComponents:aMenu
|widgets list total menu item|
item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ifFalse:[model rootItem].
item isNil ifTrue:[^ nil].
widgets := IdentityDictionary new.
total := 0.
item recursiveDo:[:el| |cls ctr|
cls := el widget.
cls notNil ifTrue:[
cls := cls class.
ctr := widgets at:cls ifAbsent:0.
widgets at:cls put:(ctr + 1).
total := total + 1.
].
].
total == 0 ifTrue:[^ nil].
list := SortedCollection sortBlock:[:a :b| a title < b title ].
widgets keysAndValuesDo:[:cls :ctr|
list add:(MenuDesc title:(cls name)
value:(ctr printString)
action:[self doSelectNextOfClass:cls startingIn:item]
).
].
list := list asOrderedCollection.
list add:(MenuDesc separator).
list add:(MenuDesc title:'Total' value:(total printString)).
menu := MenuDesc buildFromList:list onGC:aMenu.
menu do:[:el|
el hideMenuOnActivated:false
].
^ menu
!
submenuGeometry:aMenu
"builds and returns the geometry submenu"
|view point inst list x y|
view := self selectedView.
view isNil ifTrue:[^ nil].
list := OrderedCollection new.
"/ origin
point := view relativeOrigin.
point isNil ifTrue:[ point := view origin ].
x := view left.
y := view top.
(x == point x and:[y == point y]) ifTrue:[ inst := point ]
ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
list add:(MenuDesc title:'origin' value:inst).
"/ corner
point := view relativeCorner.
point isNil ifTrue:[ point := view corner ].
x := view right.
y := view bottom.
(x == point x and:[y == point y]) ifTrue:[ inst := point ]
ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
list add:(MenuDesc title:'corner' value:inst).
"/ extent
(point := view relativeExtent) isNil ifTrue:[point := view extent].
list add:(MenuDesc title:'extent' value:point).
"/ preferred extent
list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
list add:(MenuDesc separator).
"/ view insets
inst := 'l:%1 r:%2 t:%3 b:%4' bindWith:(view leftInset)
with:(view rightInset)
with:(view topInset)
with:(view bottomInset).
list add:(MenuDesc title:'insets' value:inst).
list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
list add:(MenuDesc title:'level' value:(view level)).
list add:(MenuDesc separator).
(inst := view layout) notNil ifTrue:[ inst := inst displayString ].
list add:(MenuDesc title:'layout' value:inst).
(inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
list add:(MenuDesc title:'transformation' value:inst).
^ MenuDesc buildFromList:list onGC:aMenu
!
submenuInspector:aMenu
"builds and returns the inspector submenu"
|view list n names label value|
view := self selectedView.
view isNil ifTrue:[^ nil].
n := view class instSize.
n > 0 ifFalse:[^ nil ].
list := OrderedCollection new:n.
names := view class allInstVarNames.
1 to:n do:[:i| |action|
label := (names at:i) printString.
value := view instVarAt:i.
value isNil ifTrue:[
value := '------'.
action := nil.
] ifFalse:[
value := value displayString contractAtEndTo:40.
action := [(view instVarAt:i) inspect].
].
list add:(MenuDesc title:label value:value action:action).
].
^ MenuDesc buildFromList:list onGC:aMenu
!
submenuInterface:aMenu
"builds and returns the interface submenu"
|view label inst value list|
view := self selectedView.
view isNil ifTrue:[^ nil].
list := OrderedCollection new.
inst := view controller.
value := nil.
inst isNil ifTrue:[
label := nil
] ifFalse:[
inst == view ifTrue:[ label := '== view itself' ]
ifFalse:[ label := inst displayString.
value := [view controller inspect].
].
].
list add:(MenuDesc title:'controller' value:label action:value).
inst := view delegate.
inst notNil ifTrue:[
list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
].
inst := view application.
inst notNil ifTrue:[ |topAppl|
list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
topAppl := inst topApplication.
(topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
].
].
list add:(MenuDesc separator).
(view respondsTo:#'model:') ifTrue:[
inst := model.
inst isNil ifTrue:[ label := value := nil ]
ifFalse:[ label := inst displayString.
value := [ view model inspect ].
].
list add:(MenuDesc title:'model' value:label action:value).
(inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
view modelInterface keysAndValuesDo:[:key : val|
val isNil ifTrue:[ label := nil ]
ifFalse:[ label := val displayString ].
list add:(MenuDesc title:(' - ', key) value:label ).
]
].
].
(view respondsTo:#enableChannel) ifTrue:[
inst := view enableChannel.
inst isNil ifTrue:[ label := value := nil ]
ifFalse:[ label := inst displayString.
value := [ view enableChannel inspect ].
].
list add:(MenuDesc title:'enableChannel' value:label action:value).
].
list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
(view respondsTo:#listHolder) ifTrue:[
inst := view listHolder.
inst isNil ifTrue:[ label := value := nil ]
ifFalse:[ label := inst class printString.
value := [ view listHolder inspect ].
].
list add:(MenuDesc title:'listHolder' value:label action:value).
].
(view respondsTo:#list) ifTrue:[
inst := view list.
inst isNil ifTrue:[ label := value := nil ]
ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
value := [ view list inspect ].
].
list add:(MenuDesc title:'list' value:label action:value).
].
list last isSeparator ifTrue:[ list removeLast ].
^ MenuDesc buildFromList:list onGC:aMenu
!
submenuVisibility:aMenu
"builds and returns the geometry submenu"
|view list value|
view := self selectedView.
view isNil ifTrue:[^ nil].
list := OrderedCollection new.
list add:(MenuDesc title:'device' value:(view device printString)).
list add:(MenuDesc title:'drawableId' value:(view id)).
list add:(MenuDesc title:'gcId' value:(view gcId)).
list add:(MenuDesc separator).
list add:(MenuDesc title:'shown' value:(view shown)).
list add:(MenuDesc title:'realized' value:(view realized)).
list add:(MenuDesc separator).
list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
(value := view visibilityChannel) isNil ifTrue:[
list add:(MenuDesc title:'visibilityChannel' value:'------').
] ifFalse:[
list add:(MenuDesc title:'visibilityChannel'
value:(value displayString)
action:[view visibilityChannel inspect]).
].
^ MenuDesc buildFromList:list onGC:aMenu
! !
!ViewTreeApplication methodsFor:'private'!
selectFocusView
|rootView focusItem focusView|
rootView := model rootView.
(rootView notNil and:[rootView shown]) ifTrue:[
focusView := rootView windowGroup focusView.
].
focusView isNil ifTrue:[^ self ].
focusItem := model selectedItem.
(focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
^ self
].
focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
focusItem notNil ifTrue:[
model selectItem:focusItem.
].
!
setRootItem:aRootItemOrNil
|theProcess|
aRootItemOrNil isNil ifTrue:[
process := nil.
] ifFalse:[
"/ expand tree to level 3
aRootItemOrNil do:[:aRootChild|
aRootChild do:[:aSubChild| aSubChild expand ].
aRootChild expand.
].
aRootItemOrNil expand.
process isNil ifTrue:[
theProcess := process :=
Process for:[ |update testModeChannel|
update := false.
testModeChannel := model testModeChannel.
[process == theProcess] whileTrue:[
Delay waitForSeconds:0.5.
(treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
(testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
self selectFocusView.
].
update ifTrue:[
self updateShownStatus.
].
update := update not.
].
].
] priority:8.
theProcess name:'ViewTreeApplication::Follow Focus'.
theProcess resume.
].
].
model rootItem:aRootItemOrNil.
!
updateShownStatus
|rootItem min max visState listIdx visY0 visY1 height damage|
rootItem := model rootItem.
(rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
max := 0.
min := 9999999.
rootItem recursiveEachVisibleItemDo:[:anItem|
visState := (anItem widget shown).
visState ~~ anItem isDrawnShown ifTrue:[
anItem isDrawnShown:visState.
listIdx := treeView identityIndexOf:anItem.
listIdx > 0 ifTrue:[
max := max max:listIdx.
min := min min:listIdx.
].
].
].
max < min ifTrue:[^ self].
max := max + 1.
visY0 := (treeView yVisibleOfLine:min) max:0.
visY1 := (treeView yVisibleOfLine:max) min:(treeView height).
height := visY1 - visY0.
height > 2 ifTrue:[
treeView shown ifTrue:[
damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
treeView invalidateDeviceRectangle:damage repairNow:false.
].
].
! !
!ViewTreeApplication methodsFor:'selection'!
selectedView
"answer the selected view or nil"
|item|
item := model selectedItem.
item notNil ifTrue:[ ^ item widget ].
^ nil
! !
!ViewTreeApplication methodsFor:'testing'!
resolveApplicationClassFor:aTreeItem
aTreeItem isApplicationClass ifTrue:[
^ aTreeItem applicationClass
].
^ nil
!
selectedComponentHasChildren
|item|
item := model selectedItem.
^ (item notNil and:[item hasChildren])
! !
!ViewTreeApplication methodsFor:'user operations'!
doBrowse:what
"open browser on:
#view browse class
#model browse model class
#application browse application class
#controller browse controller class
"
|view inst|
view := self selectedView.
view isNil ifTrue:[^ self].
what == #view ifTrue:[ inst := view ]
ifFalse:[what == #model ifTrue:[ inst := view model ]
ifFalse:[what == #application ifTrue:[ inst := view application ]
ifFalse:[what == #controller ifTrue:[ inst := view controller ]
ifFalse:[
^ self
]]]].
inst notNil ifTrue:[
inst class browserClass openInClass:(inst class) selector:nil
].
!
doDestroy
"destroy the current selected view"
|item parent|
item := model selectedItem.
item isNil ifTrue:[ ^ self].
parent := item parent.
parent isNil ifTrue:[
"/ the root
model withSelectionHiddenDo:[item deleteAll].
^ self
].
model withSelectionHiddenDo:[
|idx nsel|
idx := parent identityIndexOf:item.
idx == parent size ifTrue:[
nsel := parent at:(idx - 1) ifAbsent:parent
] ifFalse:[
nsel := parent at:(idx + 1)
].
model setValue:nil.
item delete.
parent isLayoutContainer ifTrue:[
parent widget sizeChanged:nil
].
model value:nsel.
].
!
doFlash
"flash the selected view"
|view|
view := self selectedView.
view isNil ifTrue:[ ^ self].
view shown ifTrue:[
model withSelectionHiddenDo:[
view perform:#flash ifNotUnderstood:nil.
].
].
!
doInspect:what
"open inspector on:
#view inspect class
#group inspect windowGroup
#model inspect model
#application inspect application
#controller inspect controller
"
|inst|
inst := self selectedView.
inst isNil ifTrue:[^ self].
what == #group ifTrue:[ inst := inst windowGroup ]
ifFalse:[what == #model ifTrue:[ inst := inst model ]
ifFalse:[what == #application ifTrue:[ inst := inst application ]
ifFalse:[what == #controller ifTrue:[ inst := inst controller ]]]].
inst notNil ifTrue:[ inst inspect ].
!
doPickViews
"pick a window's topView"
|window|
self doUnpick.
window := Screen current viewFromUser.
window isNil ifTrue:[^ self].
window := window topView.
( window == Screen current rootView
or:[window == self window topView]
) ifTrue:[
^ self
].
self setRootItem:(ViewTreeItem buildViewsFrom:window).
!
doSelectNextOfApplicationClass:aClass startingIn:anItem
|startItem firstFound searchNext|
startItem := model last.
searchNext := startItem notNil.
firstFound := nil.
anItem recursiveDo:[:el|
el == startItem ifTrue:[
searchNext := false
] ifFalse:[
(self resolveApplicationClassFor:el) == aClass ifTrue:[
searchNext ifFalse:[^ model selectItem:el].
firstFound isNil ifTrue:[
firstFound := el
]
]
]
].
firstFound notNil ifTrue:[
self window beep.
model selectItem:firstFound
].
!
doSelectNextOfClass:aClass startingIn:anItem
|startItem firstFound searchNext|
startItem := model last.
searchNext := startItem notNil.
firstFound := nil.
anItem recursiveDo:[:el|
el == startItem ifTrue:[
searchNext := false
] ifFalse:[
el widget class == aClass ifTrue:[
searchNext ifFalse:[^ model selectItem:el].
firstFound isNil ifTrue:[
firstFound := el
]
]
]
].
firstFound notNil ifTrue:[
self window beep.
model selectItem:firstFound
].
!
doUnpick
"release current picked window and contained subwindows"
self setRootItem:nil.
! !
!ViewTreeApplication::MenuDesc class methodsFor:'building'!
buildFromList:aList onGC:aMenu
|tabSpec menu w menuPanel|
w := 0.
aList do:[:el| w := w max:(el widthOn:aMenu) ].
tabSpec := TabulatorSpecification new.
tabSpec unit:#pixel.
tabSpec positions:#(0 1.5 ).
tabSpec align:#(#left #left).
w := w + 15.
tabSpec positions:(Array with:0 with:w).
menu := Menu new.
aList do:[:el|
menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
].
menuPanel := MenuPanel menu:menu.
^ menuPanel
! !
!ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!
separator
^ self new
!
title:aTitle value:aValue
^ self title:aTitle value:aValue action:nil
!
title:aTitle value:aValue action:anAction
^ self new title:aTitle value:aValue action:anAction
! !
!ViewTreeApplication::MenuDesc methodsFor:'accessing'!
title
^ title
! !
!ViewTreeApplication::MenuDesc methodsFor:'building'!
asMenuItemWithTabulatorSpecification:aTabSpec
|array|
title isNil ifTrue:[ ^ MenuItem label:value ]. "/ separator
array := Array with:(title, ':') with:'------'.
value notNil ifTrue:[
array at:2 put:(value printString, ' ')
].
^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
value:action
! !
!ViewTreeApplication::MenuDesc methodsFor:'instance creation'!
title:aTitle value:aValue action:anAction
"test for separator
"
title := aTitle withoutSeparators.
action := anAction.
aValue notNil ifTrue:[
value := aValue printString.
value size > 70 ifTrue:[
value := value copyFrom:1 to:70.
value := value, '...'
]
].
! !
!ViewTreeApplication::MenuDesc methodsFor:'queries'!
isSeparator
^ title isNil
!
widthOn:aGC
title isNil ifTrue:[^ 5]. "/ separator
^ title widthOn:aGC
! !
!ViewTreeApplication class methodsFor:'documentation'!
version
^ '$Header$'
! !
ViewTreeApplication initialize!