--- a/Tools__ViewTreeApplication.st Mon Feb 01 13:19:43 2010 +0100
+++ b/Tools__ViewTreeApplication.st Wed Feb 03 11:02:07 2010 +0100
@@ -2,22 +2,46 @@
"{ NameSpace: Tools }"
-ApplicationModel subclass:#ViewTreeApplication
+ToolApplicationModel subclass:#ViewTreeInspectorApplication
instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
motionAction process followFocusChannel showNamesHolder'
classVariableNames:''
poolDictionaries:''
- category:'A-Views-Support'
+ category:'Interface-Smalltalk'
!
Object subclass:#MenuDesc
instanceVariableNames:'title value action'
classVariableNames:''
poolDictionaries:''
- privateIn:ViewTreeApplication
+ privateIn:ViewTreeInspectorApplication
+!
+
+HierarchicalItem subclass:#ViewTreeItem
+ instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
+ classVariableNames:'HandleExtent'
+ poolDictionaries:''
+ privateIn:ViewTreeInspectorApplication
!
-!ViewTreeApplication class methodsFor:'documentation'!
+ValueModel subclass:#ViewTreeModel
+ instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
+ inputEventAction mappedViewAction beforeSelectionChangedAction
+ icons timedUpdateTask selectOnClickHolder testModeChannel
+ hasTargetWidgetChannel'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ViewTreeInspectorApplication
+!
+
+HierarchicalList subclass:#ItemList
+ instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ViewTreeInspectorApplication::ViewTreeModel
+!
+
+!ViewTreeInspectorApplication class methodsFor:'documentation'!
documentation
"
@@ -45,7 +69,7 @@
"
! !
-!ViewTreeApplication class methodsFor:'initialization'!
+!ViewTreeInspectorApplication class methodsFor:'initialization'!
initialize
"add myself to the launcher menu
@@ -54,17 +78,19 @@
!
installInLauncher
- "add myself to the launcher menu
- "
+ "add myself to the launcher menu"
+
|menuItem icon|
NewLauncher isNil ifTrue:[^ self].
+ "/ cg - disabled. the icon is too ugly.
+ ^ self.
icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
menuItem := MenuItem new
- label: 'View Inspector';
- value: [ ViewTreeApplication open];
+ label: 'View Tree Inspector';
+ value: [ ViewTreeInspectorApplication open];
isButton: true;
icon: icon;
nameKey: #viewInspect.
@@ -109,7 +135,35 @@
super unload.
! !
-!ViewTreeApplication class methodsFor:'interface specs'!
+!ViewTreeInspectorApplication class methodsFor:'image specs'!
+
+pickWindowIcon
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self pickWindowIcon inspect
+ ImageEditor openOnClass:self andSelector:#pickWindowIcon
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
+ ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
+,;N3,;N3,;N3,;N3,;N3,;N3,;N3,3H<P38;M3P,H2@^GA(VEQHQCP0KA D<[&-%XU=WST%BN#D!!GQ$TD@(IBP\BQF)+Z6E_U4-FPCX+G1,WEA@JBP$HAT23
+,;N3,;N3,;N3,;N$():Z&IRR&1!!^,;N3,;N3,;N3,;N$)JJ^&)"T$),0W[N3,;N3,;N3,;N3,:R"'')*X%IJWK523,;N3,;N3,0@@@KN3)JJ^&)"T$"5Z,;N3
+,;N3@@B3-KL@@JJ^&)"T$)D*V[N3,;N3@KN3-KR4)JH@&)"T$)*MJE"3,;N3,0B3)JJ4&*R"@I*X%IJZ#RYV,;N3,0B3@JR"-JR"-I(@%IJV%H %U[N3,;L@
+-@B4-KR4-KR4@IRR%IJEIER3,;N3@KL@)JJ4():4&@BO#9RR!!RIS,;N3,;L@,:R"-JJ^& BT#8>O#8H"T+N3,;N3@KN$@@@@'')(@%H>O#(>AH%F3,;N3,;L@
+@JR4'' @@%IJO#8>O RIO,;N3,;N3):P@@@BX%IJO#8>O#7<"S*63,;N$():Z&IRR&IRR#8>O#8=>H"&-,;N$():Z&IRR&)"T$(>O#8>O @<)R$!!GQTD?OS$8
+MSL.I2H"H"H"H"HO,;N3,;N3,;N3,;N3,;N3,;N3,;N3,0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 50 164 0 50 171 0 137 0 0 206 0 1 50 177 2 56 178 3 64 241 3 67 246 3 73 255 4 74 255 5 63 191 7 66 194 10 71 196 10 79 255 12 59 167 12 82 255 14 77 199 18 83 201 19 88 255 21 91 255 23 89 204 27 95 206 28 97 255 29 72 179 30 100 255 32 101 209 36 106 255 36 107 211 39 109 255 41 113 214 45 115 255 45 119 216 48 118 255 50 87 176 50 125 219 51 88 176 51 88 177 52 89 178 52 90 178 53 90 178 53 127 212 54 91 179 54 123 255 54 131 221 55 92 180 55 95 181 56 93 180 56 94 181 57 127 255 57 149 229 58 99 184 58 137 224 61 104 187 63 132 255 63 143 226 64 108 190 66 113 193 66 135 255 67 149 229 68 157 232 69 117 196 71 155 231 72 122 199 72 141 255 75 126 202 75 144 255 75 160 234 77 163 236 78 131 206 80 149 255 81 136 209 84 140 212 84 153 255 87 145 215 88 157 255 91 168 235 93 161 255 94 154 222 96 157 223 96 165 255 97 159 225 98 160 225 98 162 226 99 163 227 100 165 228 101 166 229 101 170 255 102 167 230 103 169 231 104 170 232 104 173 255 105 172 233 105 174 234 106 175 235 109 178 255 112 180 255 117 186 255 119 187 255 122 154 245 125 160 253 125 193 255 126 161 253 126 194 255 127 162 254 130 165 254 132 200 255 132 201 255 133 60 36 135 170 255 139 207 255 140 175 255 144 179 255 149 184 255 153 188 255 157 192 255 162 196 255 166 200 255 170 204 255 174 208 255 174 218 230 177 212 255 181 215 255 185 219 255 188 222 255 191 225 255 212 211 224 218 217 230 219 219 230 220 220 231 222 221 232 223 223 233 225 224 234 225 225 234 226 226 237 227 226 235 227 227 236 227 227 238 228 228 237 229 229 239 231 230 238 231 231 238 231 231 240 232 232 241 233 232 239 233 233 240 234 234 242 235 234 241 236 236 243 237 236 242 237 237 244 238 237 243 238 238 244 239 238 243 239 239 245 240 239 244 241 240 245 241 241 246 241 241 247 242 242 246 242 242 247 243 243 247 243 243 248 244 244 248 244 244 249 245 244 247 246 246 249 246 246 250 247 246 249 247 247 250 248 248 251 249 249 250 249 249 251 250 250 251 250 250 252 251 251 252 251 251 253 253 253 254 254 254 255 255 255 255 0 0 0]; mask:((Depth1Image new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@C????????????????????????????????????????????????????????????????????????????????@@@C') ; yourself); yourself]
+! !
+
+!ViewTreeInspectorApplication class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
@@ -131,7 +185,7 @@
name: windowSpec
window:
(WindowSpec
- label: 'ViewTreeInspector'
+ label: 'View Tree Inspector'
name: 'ViewTreeInspector'
min: (Point 10 10)
max: (Point 1024 9999)
@@ -172,7 +226,7 @@
)
! !
-!ViewTreeApplication class methodsFor:'menu specs'!
+!ViewTreeInspectorApplication class methodsFor:'menu specs'!
menu
"This resource specification was automatically generated
@@ -212,6 +266,51 @@
label: '-'
)
(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
label: 'Exit'
itemValue: closeRequest
translateLabel: true
@@ -222,41 +321,39 @@
)
)
(MenuItem
- label: 'Settings'
+ enabled: hasSingleSelectionHolder
+ label: 'Selection'
+ translateLabel: true
+ submenuChannel: middleButtonMenu
+ )
+ (MenuItem
+ label: 'Application'
translateLabel: true
submenu:
(Menu
(
(MenuItem
- label: 'Test Mode'
+ enabled: hasSingleSelectionHolder
+ label: 'Browse'
+ itemValue: doBrowse:
translateLabel: true
- hideMenuOnActivated: false
- indication: testModeChannel
+ argument: application
)
(MenuItem
- enabled: testModeChannel
- label: 'Follow Focus'
+ enabled: hasSingleSelectionHolder
+ label: 'Inspect'
+ itemValue: doInspect:
translateLabel: true
- hideMenuOnActivated: false
- indication: followFocusChannel
+ argument: application
)
(MenuItem
label: '-'
)
(MenuItem
- label: 'Select on Click'
+ enabled: hasTargetWidgetChannel
+ label: 'All Applications'
translateLabel: true
- hideMenuOnActivated: false
- indication: selectOnClickHolder
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Name of Widgets'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showNamesHolder
+ submenuChannel: submenuApplications:
)
)
nil
@@ -264,26 +361,64 @@
)
)
(MenuItem
- label: ''
- )
- (MenuItem
- enabled: hasSingleSelectionHolder
- label: 'Menu'
+ label: 'Widget'
translateLabel: true
- submenuChannel: middleButtonMenu
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ enabled: hasSingleSelectionHolder
+ label: 'Browse'
+ itemValue: doBrowse:
+ translateLabel: true
+ argument: view
+ )
+ (MenuItem
+ enabled: hasSingleSelectionHolder
+ label: 'Inspect'
+ itemValue: doInspect:
+ translateLabel: true
+ argument: view
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasTargetWidgetChannel
+ label: 'All Components'
+ translateLabel: true
+ startGroup: right
+ submenuChannel: submenuComponents:
+ )
+ )
+ nil
+ nil
+ )
)
(MenuItem
- enabled: hasTargetWidgetChannel
- label: 'Components'
+ label: 'Help'
translateLabel: true
- startGroup: right
- submenuChannel: submenuComponents:
- )
- (MenuItem
- enabled: hasTargetWidgetChannel
- label: 'Applications'
- translateLabel: true
- submenuChannel: submenuApplications:
+ startGroup: conditionalRight
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Documentation'
+ itemValue: openDocumentation
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'About this Application...'
+ itemValue: openAboutThisApplication
+ translateLabel: true
+ )
+ )
+ nil
+ nil
+ )
)
)
nil
@@ -463,47 +598,40 @@
#(Menu
(
(MenuItem
+ label: 'Pick a View'
+ itemValue: doPickViews
+ translateLabel: false
+ isButton: true
+ hideMenuOnActivated: false
+ labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon)
+ )
+ (MenuItem
enabled: hasSingleSelectionHolder
- label: 'Application'
+ label: 'Browse Application'
itemValue: doBrowse:
translateLabel: false
+ isButton: true
+ hideMenuOnActivated: false
labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
argument: application
)
(MenuItem
enabled: hasSingleSelectionHolder
- label: 'Application'
+ label: 'Inspect Application'
itemValue: doInspect:
translateLabel: false
- labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
+ isButton: true
+ hideMenuOnActivated: false
+ labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
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'!
+!ViewTreeInspectorApplication methodsFor:'actions'!
indicatorClicked:anIndex
|item sensor|
@@ -521,7 +649,7 @@
].
! !
-!ViewTreeApplication methodsFor:'aspects'!
+!ViewTreeInspectorApplication methodsFor:'aspects'!
followFocusChannel
"boolean holder, which indicates whether selection changed dependend on the focus view"
@@ -576,7 +704,7 @@
^ model testModeChannel
! !
-!ViewTreeApplication methodsFor:'change & update'!
+!ViewTreeInspectorApplication methodsFor:'change & update'!
selectionChanged
"called if the selection changed"
@@ -625,7 +753,7 @@
super update:something with:someArgument from:aModel.
! !
-!ViewTreeApplication methodsFor:'event processing'!
+!ViewTreeInspectorApplication methodsFor:'event processing'!
processButtonMotionEvent:ev
"handle a button motion event"
@@ -845,7 +973,7 @@
].
! !
-!ViewTreeApplication methodsFor:'initialization & release'!
+!ViewTreeInspectorApplication methodsFor:'initialization & release'!
closeDownViews
"release the grapped application"
@@ -879,7 +1007,7 @@
treeView hasConstantHeight:true.
! !
-!ViewTreeApplication methodsFor:'menu queries'!
+!ViewTreeInspectorApplication methodsFor:'menu queries'!
hasApplication
"returns true if the current selected view has an application"
@@ -914,7 +1042,7 @@
^ (view notNil and:[view model notNil])
! !
-!ViewTreeApplication methodsFor:'menu specs'!
+!ViewTreeInspectorApplication methodsFor:'menu specs'!
middleButtonMenu
"returns the middleButton menu for the single selected item or nil"
@@ -1226,7 +1354,7 @@
^ MenuDesc buildFromList:list onGC:aMenu
! !
-!ViewTreeApplication methodsFor:'private'!
+!ViewTreeInspectorApplication methodsFor:'private'!
selectFocusView
|rootView focusItem focusView|
@@ -1285,7 +1413,7 @@
].
] priority:8.
- theProcess name:'ViewTreeApplication::Follow Focus'.
+ theProcess name:'ViewTreeInspector - Follow Focus'.
theProcess resume.
].
].
@@ -1329,7 +1457,7 @@
].
! !
-!ViewTreeApplication methodsFor:'selection'!
+!ViewTreeInspectorApplication methodsFor:'selection'!
selectedView
"answer the selected view or nil"
@@ -1341,7 +1469,7 @@
^ nil
! !
-!ViewTreeApplication methodsFor:'testing'!
+!ViewTreeInspectorApplication methodsFor:'testing'!
resolveApplicationClassFor:aTreeItem
aTreeItem isApplicationClass ifTrue:[
@@ -1357,7 +1485,7 @@
^ (item notNil and:[item hasChildren])
! !
-!ViewTreeApplication methodsFor:'user operations'!
+!ViewTreeInspectorApplication methodsFor:'user operations'!
doBrowse:what
"open browser on:
@@ -1532,9 +1660,13 @@
"release current picked window and contained subwindows"
self setRootItem:nil.
+!
+
+openDocumentation
+ HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
! !
-!ViewTreeApplication::MenuDesc class methodsFor:'building'!
+!ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
buildFromList:aList onGC:aMenu
|tabSpec menu w menuPanel|
@@ -1559,7 +1691,7 @@
^ menuPanel
! !
-!ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!
+!ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
separator
^ self new
@@ -1573,13 +1705,13 @@
^ self new title:aTitle value:aValue action:anAction
! !
-!ViewTreeApplication::MenuDesc methodsFor:'accessing'!
+!ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
title
^ title
! !
-!ViewTreeApplication::MenuDesc methodsFor:'building'!
+!ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
asMenuItemWithTabulatorSpecification:aTabSpec
|array|
@@ -1596,7 +1728,7 @@
value:action
! !
-!ViewTreeApplication::MenuDesc methodsFor:'instance creation'!
+!ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
title:aTitle value:aValue action:anAction
"test for separator
@@ -1614,7 +1746,7 @@
].
! !
-!ViewTreeApplication::MenuDesc methodsFor:'queries'!
+!ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
isSeparator
^ title isNil
@@ -1625,10 +1757,2136 @@
^ title widthOn:aGC
! !
-!ViewTreeApplication class methodsFor:'documentation'!
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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
+"
+!
version
^ '$Header$'
! !
-ViewTreeApplication initialize!
+!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
+
+initialize
+ "set the extent of the Handle
+ "
+ HandleExtent := 6@6.
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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)
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
+
+forView:aView
+ widget := aView.
+!
+
+initialize
+ "setup default attributes
+ "
+ super initialize.
+ isDrawnShown := false.
+ isExpanded := false.
+ children := OrderedCollection new.
+! !
+
+!ViewTreeInspectorApplication::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
+ ].
+! !
+
+!ViewTreeInspectorApplication::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.
+! !
+
+!ViewTreeInspectorApplication::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
+ ]
+ ]
+ ].
+! !
+
+!ViewTreeInspectorApplication::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.
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::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
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
+
+documentation
+"
+ Instances of ViewTreeModel can be used as model on a View and all
+ it contained subviews for a HierarchicalListView.
+ The model keeps two values, the hierarchical representation of the views
+ and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
+ It shows the selected items highlighted.
+
+
+ [Instance variables:]
+ lockSema <Semaphore> lock selection notifications and redraws
+
+ testModeChannel <ValueHolder> true, than running in test mode.
+
+ hasTargetWidgetChannel <ValueHolder> true, than any target view is grapped
+
+ selection <Sequence or nil> selected items or nil
+
+ hiddenLevel <Integer> internal use; redrawing the selection
+ only is done if the counter is 0.
+
+ listOfItems <HierarchicalList> hiearchical list build from existing items.
+
+ selectedSuperItems <Sequence> list of selected super items; items selected
+ but not contained in another selected item.
+
+ inputEventAction <Action> called for each InputEvent
+
+ mappedViewAction <Action> called for a new mapped view which
+ can not be found in the current item list.
+
+ beforeSelectionChangedAction <Action> called before the selection changed
+
+ [author:]
+ Claus Atzkern
+
+ [see also:]
+ ViewTreeItem
+"
+!
+
+examples
+"
+ example 1: pick any window and show views and contained views
+ [exBegin]
+ |top sel model panel|
+
+ model := ViewTreeModel new.
+ top := StandardSystemView new; extent:440@400.
+ sel := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
+ sel bottomInset:24.
+
+ panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
+ panel topInset:-24.
+ panel horizontalLayout:#fitSpace.
+
+ Button label:'Exit' action:[model rootItem:nil. top destroy] in:panel.
+ Button label:'Pick Views' action:[ |win|
+ ( (win := Screen current viewFromUser) notNil
+ and:[(win := win topView) ~~ Screen current rootView
+ and:[win ~~ top]]
+ ) ifTrue:[
+ model rootItem:(ViewTreeItem buildViewsFrom:win)
+ ] ifFalse:[
+ model rootItem:nil
+ ]
+ ] in:panel.
+
+ sel multipleSelectOk:true.
+ sel list:model listOfItems.
+ sel model:model.
+ sel useIndex:false.
+
+ sel doubleClickAction:[:i| |el|
+ el := model listOfItems at:i.
+ el spec notNil ifTrue:[ el spec inspect ] ifFalse:[ el widget inspect ]
+ ].
+ sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
+
+ model inputEventAction:[:anEvent| |item|
+ anEvent isButtonEvent ifTrue:[
+ anEvent isButtonPressEvent ifTrue:[
+ model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
+ ] ifFalse:[
+ anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
+ (item := model selectedItem) notNil ifTrue:[item widget inspect]
+ ]
+ ]
+ ]
+ ].
+
+ top openAndWait.
+ [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
+
+ [exEnd]
+"
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
+
+application:anApplication
+ listOfItems application:anApplication.
+!
+
+rootItem
+ "get the rootItem the event viewer is established on
+ "
+ ^ listOfItems root
+!
+
+rootItem:anItem
+ "set the rootItem the event viewer is established on
+ "
+ |expanded|
+
+ timedUpdateTask := nil.
+ self deselect.
+
+ lockSema critical:[
+ anItem notNil ifTrue:[ expanded := anItem isExpanded ]
+ ifFalse:[ expanded := false ].
+
+ self value:nil.
+ listOfItems root:anItem.
+
+ anItem notNil ifTrue:[
+ timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
+ timedUpdateTask name:'Update'.
+ timedUpdateTask resume.
+ ].
+ ].
+
+ (expanded and:[anItem notNil]) ifTrue:[
+ anItem expand
+ ].
+ ^ anItem
+!
+
+rootView
+ "get the top widget the event viewer is established on, a View
+ "
+ ^ listOfItems rootView
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
+
+beforeSelectionChangedAction
+ "none argument action which is called before
+ the selection changed
+ "
+ ^ beforeSelectionChangedAction
+!
+
+beforeSelectionChangedAction:aNoneArgBlock
+ "none argument action which is called before
+ the selection changed
+ "
+ beforeSelectionChangedAction := aNoneArgBlock.
+!
+
+inputEventAction
+ "called for each input event; the argument to the action is the WindowEvent
+ "
+ ^ inputEventAction
+!
+
+inputEventAction:aOneArgActionTheEvent
+ "called for each input event; the argument to the action is the WindowEvent
+ "
+ inputEventAction := aOneArgActionTheEvent.
+!
+
+mappedViewAction
+ "called for a new mapped view which can not be found
+ in the current item list
+ "
+ ^ mappedViewAction
+!
+
+mappedViewAction:aOneArgBlockTheMappedView
+ "called for a new mapped view which can not be found
+ in the current item list
+ "
+ mappedViewAction := aOneArgBlockTheMappedView
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
+
+iconAt:aKey ifNonePut:aNoneArgBlock
+ |icon view|
+
+ icon := icons at:aKey ifAbsent:nil.
+ icon notNil ifTrue:[^ icon].
+
+ icon := aNoneArgBlock value.
+ icon isNil ifTrue:[^ nil].
+
+ view := self rootView.
+ view isNil ifTrue:[^ icon].
+
+ icon := icon copy onDevice:(view device).
+ icon isImage ifTrue:[
+ icon clearMaskedPixels.
+ ].
+ icons at:aKey put:icon.
+ ^ icon
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
+
+signalHiddenLevel
+ "show the selection if signaled; increments hiddenLevel
+ see: #waitHiddenLevel
+ "
+ (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
+ hiddenLevel := 0.
+ self invalidateSelection.
+ ].
+!
+
+waitHiddenLevel
+ "hide the selection until signaled; increments hiddenLevel
+ see: #signalHiddenLevel
+ "
+ self redrawUnselected:selection andLock:true
+!
+
+withSelectionHiddenDo:aNoneArgumentBlock
+ "apply block with selection hidden
+ "
+
+ [ self waitHiddenLevel.
+
+ aNoneArgumentBlock value
+
+ ] valueNowOrOnUnwindDo:[
+ self signalHiddenLevel.
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
+
+hasTargetWidgetChannel
+ "answer the channel which is set to true if a target widget exists"
+
+ ^ hasTargetWidgetChannel
+!
+
+listOfItems
+ "hiearchical list build from existing items"
+
+ ^ listOfItems
+!
+
+selectOnClickHolder
+ "boolean holder, which indicates whether the selection will change on click
+ "
+ ^ selectOnClickHolder
+!
+
+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."
+
+ ^ testModeChannel
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
+
+targetWidgetChanged
+ hasTargetWidgetChannel value:(self rootItem notNil).
+!
+
+timedUpdateTaskCycle
+ |view myTaskId|
+
+ myTaskId := timedUpdateTask.
+
+ listOfItems root notNil ifTrue:[
+ view := listOfItems root widget.
+ ].
+
+ [ view notNil ] whileTrue:[
+ Delay waitForSeconds:0.5.
+
+ (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
+ view := nil.
+ ] ifTrue:[
+ (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
+ view sensor pushUserEvent:#updateChildren for:self.
+ ].
+ ].
+ ].
+ timedUpdateTask == myTaskId ifTrue:[
+ timedUpdateTask := nil.
+ listOfItems root:nil.
+ ].
+!
+
+update:something with:someArgument from:aModel
+
+ aModel == testModeChannel ifTrue:[
+ (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
+ testModeChannel value ifTrue:[
+ self redrawUnselected:selection andLock:false checkTestMode:false.
+ ] ifFalse:[
+ self invalidateSelection.
+ ].
+ ].
+ ^ self
+ ].
+ super update:something with:someArgument from:aModel.
+!
+
+updateChildren
+ |rootItem|
+
+ rootItem := listOfItems root.
+ rootItem isNil ifTrue:[^ self].
+
+ rootItem exists ifFalse:[
+ listOfItems root:nil.
+ ] ifTrue:[
+ rootItem updateChildren.
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
+
+processEvent:anEvent
+ "catch and process all WindowEvents for the rootComponent and its contained
+ widgets; redraw selection in case of damage ....
+ "
+ |evView item rootView testMode|
+
+ evView := anEvent view.
+ evView isNil ifTrue:[
+ (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[
+ ^ false
+ ].
+ anEvent value.
+ ^ true.
+ ].
+ rootView := listOfItems rootView.
+ rootView isNil ifTrue:[ ^ false ].
+
+ anEvent isConfigureEvent ifTrue:[
+ hiddenLevel == 0 ifTrue:[
+ self redrawUnselected:selection andLock:false.
+ ].
+ ^ false
+ ].
+
+ "/ check whether view is contained within the rootView
+ (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
+ ^ false
+ ].
+
+ anEvent isInputEvent ifFalse:[
+ anEvent isDamage ifTrue:[
+ hiddenLevel == 0 ifTrue:[self invalidateSelection].
+ ^ false
+ ].
+
+ anEvent isMapEvent ifTrue:[
+ mappedViewAction notNil ifTrue:[
+ item := listOfItems recursiveDetect:[:el| el widget == evView].
+ item isNil ifTrue:[ mappedViewAction value:evView ]
+ ].
+ ^ false
+ ].
+
+ anEvent type == #terminate ifTrue:[
+ item := listOfItems recursiveDetect:[:el| el widget == evView].
+ item notNil ifTrue:[ self processTerminateForItem:item ].
+ ^ false
+ ].
+ ^ false
+ ].
+ testMode := testModeChannel value.
+
+ anEvent isFocusEvent ifTrue:[
+ evView == rootView ifTrue:[
+ self invalidateSelection
+ ].
+ ^ testMode not.
+ ].
+ anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
+
+ testMode ifFalse:[
+ inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
+ ] ifTrue:[
+ anEvent isButtonPressEvent ifTrue:[
+ selectOnClickHolder value ifTrue:[
+ self selectItem:(listOfItems detectItemRespondsToView:evView).
+ ].
+ ]
+ ].
+
+ (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
+ hiddenLevel := 1.
+ self signalHiddenLevel.
+ ].
+
+ ^ testMode not
+!
+
+processTerminateForItem:anItem
+ "received terminate for an item
+ "
+ anItem remove.
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
+
+initialize
+ "setup the default attributes
+ "
+ super initialize.
+
+ hiddenLevel := 0.
+ lockSema := RecursionLock new.
+ listOfItems := ItemList new on:self.
+ selectedSuperItems := #().
+ icons := IdentityDictionary new.
+
+ hasTargetWidgetChannel := false asValue.
+ selectOnClickHolder := true asValue.
+
+ testModeChannel := false asValue.
+ testModeChannel addDependent:self.
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
+
+invalidateSelection
+ "invalidate the current selection
+ "
+ |topView|
+
+ testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
+
+ ( hiddenLevel == 0
+ and:[selection notNil
+ and:[(topView := listOfItems rootView) notNil
+ and:[topView shown]]]
+ ) ifTrue:[
+ topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
+ ]
+!
+
+recursiveRepair:theDamages startIn:aView relativeTo:aRootView
+ "repair all views and contained views, which intersects the damage.
+ !!!! all damages repaired are removed from the list of damages !!!!
+ "
+ |color relOrg damage subViews repaired
+ bwWidth "{ Class:SmallInteger }"
+ x "{ Class:SmallInteger }"
+ y "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ relOrgX "{ Class:SmallInteger }"
+ relOrgY "{ Class:SmallInteger }"
+ width "{ Class:SmallInteger }"
+ height "{ Class:SmallInteger }"
+ size "{ Class:SmallInteger }"
+ |
+ (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
+
+ subViews := aView subViews.
+
+ subViews size ~~ 0 ifTrue:[
+ subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
+ theDamages isEmpty ifTrue:[ ^ self ].
+ ].
+
+ relOrg := aView originRelativeTo:aRootView.
+ bwWidth := aView borderWidth.
+ size := theDamages size.
+
+ "/ compute relative origin starting from border left@top
+ relOrgX := relOrg x - bwWidth.
+ relOrgY := relOrg y - bwWidth.
+ width := aView width + bwWidth + bwWidth.
+ height := aView height + bwWidth + bwWidth.
+
+ size to:1 by:-1 do:[:anIndex|
+ repaired := damage := theDamages at:anIndex.
+
+ "/ compute the rectangle into the view
+ y := damage top - relOrgY.
+ x := damage left - relOrgX.
+ w := damage width.
+ h := damage height.
+
+ x < 0 ifTrue:[ w := w + x. x := 0. repaired := nil ].
+ y < 0 ifTrue:[ h := h + y. y := 0. repaired := nil ].
+ x + w > width ifTrue:[ w := width - x. repaired := nil ].
+ y + h > height ifTrue:[ h := height - y. repaired := nil ].
+
+ (w > 0 and:[h > 0]) ifTrue:[
+ bwWidth ~~ 0 ifTrue:[
+ color isNil ifTrue:[
+ "/ must force redraw of border
+ color := aView borderColor.
+ aView borderColor:(Color colorId:1).
+ aView borderColor:color.
+ ].
+ w := w - bwWidth.
+ h := h - bwWidth.
+
+ (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
+ (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
+
+ h > 0 ifFalse:[w := 0]. "/ later testing on width only
+ ].
+
+ w > 0 ifTrue:[
+ aView clearRectangleX:x y:y width:w height:h.
+ aView exposeX:x y:y width:w height:h
+ ].
+ repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
+ ]
+ ].
+!
+
+redrawSelection
+ "redraw all items selected
+ "
+ |topView size|
+
+ testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
+
+ ( hiddenLevel == 0
+ and:[(size := selection size) > 0
+ and:[(topView := listOfItems rootView) notNil
+ and:[topView shown
+ and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ lockSema critical:[
+ |list|
+
+ list := selection.
+
+ list size > 0 ifTrue:[
+ topView paint:(Color black).
+ topView clippedByChildren:false.
+
+ list keysAndValuesReverseDo:[:anIndex :anItem|
+ (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
+
+ anItem handlesDo:[:aRect :what|
+ what isNil ifTrue:[topView displayRectangle:aRect]
+ ifFalse:[topView fillRectangle:aRect]
+ ]
+ ].
+ topView clippedByChildren:true.
+ ].
+ ].
+!
+
+redrawUnselected:aList andLock:doLock
+ "redraw all items unselected; if doLock is true, the hiddenLevel
+ is incremented and thus the select mechanism is locked.
+ "
+ self redrawUnselected:aList andLock:doLock checkTestMode:true.
+!
+
+redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
+ "redraw all items unselected; if doLock is true, the hiddenLevel
+ is incremented and thus the select mechanism is locked.
+ "
+ |rootView damages subViews x y w h|
+
+ doLock ifTrue:[
+ hiddenLevel := hiddenLevel + 1.
+ hiddenLevel ~~ 1 ifTrue:[^ self].
+ ] ifFalse:[
+ hiddenLevel ~~ 0 ifTrue:[^ self].
+ ].
+ checkTestMode ifTrue:[
+ testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
+ ].
+
+ ( aList size ~~ 0
+ and:[(rootView := listOfItems rootView) notNil
+ and:[rootView shown]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ lockSema critical:[
+ damages := OrderedCollection new:(8 * aList size).
+
+ aList do:[:item|
+ item handlesDo:[:handle :what|
+ damages reverseDo:[:el|
+ (el intersects:handle) ifTrue:[
+ damages removeIdentical:el.
+
+ handle left:(handle left min:el left)
+ right:(handle right max:el right)
+ top:(handle top min:el top)
+ bottom:(handle bottom max:el bottom)
+ ]
+ ].
+ damages add:handle
+ ]
+ ].
+
+ damages do:[:el|
+ x := el left.
+ y := el top.
+ w := el width.
+ h := el height.
+
+ rootView clearRectangleX:x y:y width:w height:h.
+ rootView exposeX:x y:y width:w height:h.
+ ].
+
+ (subViews := rootView subViews) notNil ifTrue:[
+ subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
+ ].
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
+
+isInTestMode
+ "answer false, all input events are eaten and the selection is shown on the target view.
+ answer true, no input events are eaten and no selection is shown on the target view."
+
+ ^ testModeChannel value
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
+
+at:anIndex
+ "returns the selected item at an index or nil
+ "
+ selection notNil ifTrue:[
+ ^ selection at:anIndex ifAbsent:nil
+ ].
+ ^ nil
+!
+
+at:anIndex ifAbsent:aBlock
+ "returns the selected item at an index or the result of the block
+ "
+ selection notNil ifTrue:[
+ ^ selection at:anIndex ifAbsent:aBlock
+ ].
+ ^ aBlock value
+!
+
+first
+ "returns the first selected item or nil
+ "
+ ^ self at:1
+!
+
+last
+ "returns the last selected item or nil
+ "
+ ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
+!
+
+selectedItem
+ "returns the single selected item or nil (size ~~ 1 nil is returned)
+ "
+ ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
+!
+
+selectedSuperItems
+ "returs the list of selected superItems; items selected
+ but not contained in another selected item.
+ "
+ ^ selectedSuperItems
+!
+
+size
+ "returns the number of items selected
+ "
+ ^ selection size
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
+
+add:item
+ "add an item to the current selection
+ "
+ |newSelect|
+
+ item isNil ifTrue:[^ item].
+
+ lockSema critical:[
+ selection isNil ifTrue:[
+ newSelect := Array with:item.
+ ] ifFalse:[
+ (self includes:item) ifFalse:[
+ newSelect := selection copyWith:item
+ ]
+ ].
+
+ newSelect size ~~ selection size ifTrue:[
+ item makeVisible.
+ self value:newSelect
+ ]
+ ].
+ ^ item
+!
+
+addAll:aCollectionOfItems
+ "add a collection of items to the current selection
+ "
+ |newSelect|
+
+ aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
+
+ lockSema critical:[
+ selection isNil ifTrue:[
+ newSelect := Array withAll:aCollectionOfItems.
+ ] ifFalse:[
+ newSelect := OrderedCollection withAll:selection.
+
+ aCollectionOfItems do:[:el|
+ (selection includesIdentical:el) ifFalse:[newSelect add:el]
+ ].
+ ].
+ self value:newSelect.
+ ].
+ ^ aCollectionOfItems
+!
+
+deselect
+ "clear the selection
+ "
+ self value:nil.
+!
+
+remove:item
+ "remove the item from the current selection
+ "
+ |newSelect|
+
+ item isNil ifTrue:[^ nil].
+
+ lockSema critical:[
+ (selection notNil and:[selection includesIdentical:item]) ifTrue:[
+ selection size == 1 ifTrue:[ newSelect := nil ]
+ ifFalse:[ newSelect := selection copyWithout:item ].
+
+ self value:newSelect
+ ].
+ ].
+ ^ item
+!
+
+removeAll
+ "clear the selection
+ "
+ self deselect.
+!
+
+removeAll:loItems
+ "remove all items of the collection from the current selection
+ "
+ |newSelect|
+
+ selection isNil ifTrue:[ ^ loItems ].
+ loItems size == 0 ifTrue:[ ^ loItems ].
+
+ lockSema critical:[
+ selection notNil ifTrue:[
+ newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
+ self value:newSelect.
+ ]
+ ].
+ ^ loItems
+!
+
+selectAll
+ "select all items
+ "
+ |root newSelection|
+
+ root := listOfItems root.
+
+ root isNil ifTrue:[
+ newSelection := nil
+ ] ifFalse:[
+ newSelection := OrderedCollection new.
+ root recursiveDo:[:el| newSelection add:el ].
+ ].
+ self value:newSelection.
+!
+
+selectItem:anItem
+ "set the current selection to the item
+ "
+ self value:anItem
+!
+
+selectRootItem
+ "set the current selection to the root item
+ "
+ self value:(self rootItem).
+!
+
+selectedItem:anItem
+ "set the current selection to the item
+ "
+ self selectItem:anItem.
+!
+
+toggleSelectItem:anItem
+ "toggle selection-state of the item; add or remove the item from the
+ current selection.
+ "
+ anItem notNil ifTrue:[
+ (self includes:anItem) ifTrue:[self remove:anItem]
+ ifFalse:[self add:anItem]
+ ].
+ ^ anItem
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
+
+collect:aBlock
+ "for each element in the selection, evaluate the argument, aBlock
+ and return a new collection with the results
+ "
+ |res|
+
+ res := OrderedCollection new.
+ self do:[:el| res add:(aBlock value:el)].
+ ^ res
+!
+
+do:aOneArgBlock
+ "evaluate the argument, aBlock for each item in the selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection do:aOneArgBlock
+!
+
+from:start do:aOneArgBlock
+ "evaluate the argument, aBlock for the items starting at index start
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection from:start do:aOneArgBlock
+!
+
+from:start to:stop do:aOneArgBlock
+ "evaluate the argument, aBlock for the items with index start to
+ stop in the selection.
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection from:start to:stop do:aOneArgBlock
+!
+
+reverseDo:aOneArgBlock
+ "evaluate the argument, aBlock for each item in the selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection reverseDo:aOneArgBlock
+!
+
+select:aBlock
+ "return a new collection with all elements from the selection, for which
+ the argument aBlock evaluates to true.
+ "
+ |res|
+
+ res := OrderedCollection new.
+ self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
+ ^ res
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
+
+changed:aParameter with:oldSelection
+ "update the visibility staus of the current selection
+ "
+ |unselected rootView rootItem selSize|
+
+ selSize := selection size.
+
+ selSize == 0 ifTrue:[
+ selectedSuperItems := #().
+ ] ifFalse:[
+ selSize == 1 ifTrue:[
+ selectedSuperItems := Array with:(selection at:1).
+ ] ifFalse:[
+ rootItem := listOfItems root.
+
+ (selection includesIdentical:rootItem) ifTrue:[
+ selectedSuperItems := Array with:rootItem.
+ ] ifFalse:[
+ selectedSuperItems := OrderedCollection new:selSize.
+
+ selection do:[:anItem|
+ anItem parentsDetect:[:el| selection includesIdentical:el ]
+ ifNone:[ selectedSuperItems add:anItem ].
+ ].
+ ]
+ ]
+ ].
+
+ ( hiddenLevel == 0
+ and:[(rootView := listOfItems rootView) notNil
+ and:[rootView shown]]
+ ) ifTrue:[
+ selSize == 0 ifTrue:[
+ "/ must redraw the old selection unselected
+ self redrawUnselected:oldSelection andLock:false
+ ] ifFalse:[
+ self invalidateSelection.
+
+ oldSelection size ~~ 0 ifTrue:[
+ "/ must redraw all elements no longer in the selection
+ unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
+ self redrawUnselected:unselected andLock:false.
+ ]
+ ]
+ ].
+ super changed:aParameter with:oldSelection.
+!
+
+setValue:aNewSelection
+ "set the selection without notifying
+ "
+ |newSelect idx|
+
+ newSelect := nil.
+
+ aNewSelection notNil ifTrue:[
+ lockSema critical:[
+ aNewSelection isCollection ifFalse:[
+ (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
+ newSelect := selection
+ ] ifFalse:[
+ newSelect := Array with:aNewSelection.
+ ]
+ ] ifTrue:[
+ aNewSelection notEmpty ifTrue:[
+ aNewSelection size ~~ selection size ifTrue:[
+ newSelect := aNewSelection copy.
+ ] ifFalse:[
+ idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
+
+ idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
+ ifFalse:[newSelect := selection ].
+ ]
+ ]
+ ]
+ ].
+ ].
+ newSelect ~~ selection ifTrue:[
+ beforeSelectionChangedAction value.
+ selection := newSelect.
+ selection notNil ifTrue:[selection do:[:el| el makeVisible]]
+ ].
+!
+
+triggerValue:aValue
+ "set my value & send change notifications to my dependents.
+ Send the change message even if the value didn't change.
+ "
+ |oldSelection|
+
+ lockSema critical:[
+ oldSelection := selection.
+ self setValue:aValue.
+ self changed:#value with:oldSelection
+ ]
+!
+
+value
+ "returns the current selection
+ "
+ ^ selection ? #()
+!
+
+value:aValue
+ "change the current selection and send change notifications to my
+ dependents if it changed.
+ "
+ |oldSelection|
+
+ lockSema critical:[
+ oldSelection := selection.
+ self setValue:aValue.
+
+ oldSelection == selection ifFalse:[
+ self changed:#value with:oldSelection
+ ]
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
+
+detect:aBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation.
+ If none of the evaluations returns true, an error is raised
+ "
+ ^ self detect:aBlock ifNone:[self errorNotFound]
+!
+
+detect:aBlock ifNone:exceptionBlock
+ "evaluate the argument, aBlock for each item in the selection until the
+ block returns true; in this case return the element which caused the
+ true evaluation.
+ If none of the evaluations returns true, the result of the evaluation
+ of the exceptionBlock is returned
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
+ ^ cashedSelection detect:aBlock ifNone:exceptionBlock
+!
+
+detectLast:aBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation. The items are processed in reverse order.
+ If none of the evaluations returns true, an error is raised
+ "
+ ^ self detectLast:aBlock ifNone:[self errorNotFound]
+!
+
+detectLast:aBlock ifNone:exceptionBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation. The items are processed in reverse order.
+ If none of the evaluations returns true, the result of the evaluation
+ of the exceptionBlock is returned
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
+ ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
+
+includes:anItem
+ "returns true if the item is in the current selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ false].
+ ^ cashedSelection includesIdentical:anItem
+!
+
+includesAll:aCollection
+ "return true, if all items of the collection are included in the current selection
+ "
+ |cashedSelection|
+
+ aCollection size ~~ 0 ifTrue:[
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ false ].
+
+ aCollection do:[:el|
+ (cashedSelection includesIdentical:el) ifFalse:[^ false]
+ ]
+ ].
+ ^ true
+!
+
+includesAny:aCollection
+ "return true, if the any item of the collection is in the current selection
+ "
+ |cashedSelection|
+
+ aCollection notNil ifTrue:[
+ cashedSelection := selection.
+
+ cashedSelection notNil ifTrue:[
+ aCollection do:[:el|
+ (cashedSelection includesIdentical:el) ifTrue:[^ true]
+ ]
+ ]
+ ].
+ ^ false
+!
+
+includesIdentical:anItem
+ "returns true if the item is in the current selection
+ "
+ ^ self includes:anItem
+!
+
+isEmpty
+ "returns true if the current selection is empty
+ "
+ ^ selection size == 0
+!
+
+isSelected:anItem
+ "returns true if the item is in the current selection
+ "
+ ^ self includes:anItem
+!
+
+notEmpty
+ "returns true if the current selection is not empty
+ "
+ ^ selection size ~~ 0
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
+
+documentation
+"
+ Kind of HierarchicalList class which contains all the visible
+ ViewTreeItem's and the root, the anchor of the hierarchical list.
+
+ [Instance variables:]
+ treeModel <ViewTreeModel> all events are delegated to
+ eventHook <BlockValue> save and resore the pre/post -EventHook
+
+
+ [author:]
+ Claus Atzkern
+
+ [see also:]
+ HierarchicalList
+ ViewTreeModel
+ ViewTreeItem
+"
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
+
+root:theRoot
+ "set the root item; delegate events to my treeModel
+ "
+ |rootView|
+
+ theRoot == root ifTrue:[^ self].
+
+ rootView := self rootView.
+ super root:theRoot.
+
+ rootView notNil ifTrue:[ |wgrp|
+ wgrp := rootView windowGroup.
+
+ wgrp notNil ifTrue:[
+ wgrp removePreEventHook:treeModel.
+ wgrp removePostEventHook:self.
+ ].
+ ].
+
+ super root:theRoot.
+ rootView := self rootView.
+
+ rootView notNil ifTrue:[
+ "must setup a task because there might not exist a windowGroup at the moment
+ "
+ [ |wgrp|
+
+ [rootView == self rootView] whileTrue:[
+ wgrp := rootView windowGroup.
+ wgrp notNil ifTrue:[
+ rootView := nil.
+ wgrp addPreEventHook:treeModel.
+ wgrp addPostEventHook:self.
+ ] ifFalse:[
+ Delay waitForMilliseconds:100.
+ ].
+ ].
+
+ ] forkAt:(Processor userSchedulingPriority + 2).
+ ].
+ treeModel notNil ifTrue:[
+ treeModel targetWidgetChanged.
+ ].
+
+ ^ root.
+!
+
+rootView
+ "returns the widget assigned to the root or nil
+ "
+ ^ root notNil ifTrue:[root widget] ifFalse:[nil]
+!
+
+treeModel
+ "returne the treeModel, a ViewTreeModel
+ "
+ ^ treeModel
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
+
+additionalLabelForItem:anItem
+ "answer the additional lable for an item or nil"
+
+ |applClass|
+
+ showWidgetNames == true ifTrue:[
+ ^ '[', anItem widget name, ']'
+ ].
+
+ anItem isApplicationClass ifTrue:[
+ applClass := anItem applicationClass.
+
+ applClass notNil ifTrue:[
+ ^ ('[', applClass name, ']')
+ ].
+ ].
+ ^ nil
+!
+
+showWidgetNames
+ "answer true if the additional text is the widget name
+ otherwise the name of the application"
+
+ ^ showWidgetNames ? false
+!
+
+showWidgetNames:aBoolean
+ "set true if the additional text is the widget name
+ otherwise the name of the application"
+
+ self showWidgetNames == aBoolean ifFalse:[
+ showWidgetNames := aBoolean.
+
+ root notNil ifTrue:[
+ root recursiveAdditionalNameBehaviourChanged.
+ self changed.
+ ].
+ ].
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
+
+processEvent:anEvent
+ "post process event
+ "
+ ^ treeModel isInTestMode not
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
+
+on:aModel
+ "set the model, a ViewTreeModel
+ "
+ treeModel := aModel.
+ showRoot := true.
+ showWidgetNames := false.
+! !
+
+!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
+
+detectItemRespondsToView:aView
+ "returns the bottom-most item which contains the view
+ "
+ |view item topView|
+
+ root notNil ifTrue:[
+ view := aView.
+ topView := root widget.
+
+ [ view notNil ] whileTrue:[
+ topView == view ifTrue:[^ root].
+ item := root recursiveDetect:[:el| el widget == view ].
+ item notNil ifTrue:[^ item].
+ view := view superView
+ ]
+ ].
+ ^ nil
+!
+
+recursiveDetect:aOneOrgBlock
+ "recursive find the first child, for which evaluation
+ of the block returns true; if none nil is returned
+ "
+ root notNil ifTrue:[
+ (aOneOrgBlock value:root) ifTrue:[ ^ root ].
+ ^ root recursiveDetect:aOneOrgBlock
+ ].
+ ^ nil
+! !
+
+!ViewTreeInspectorApplication class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
+ViewTreeInspectorApplication initialize!
+ViewTreeInspectorApplication::ViewTreeItem initialize!