Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 10 Feb 2010 23:10:55 +0100
changeset 2762 0c66aa3bfdff
parent 2759 d9a8fc3f0dc7
child 2770 9322aee00ea0
permissions -rw-r--r--
added:
#doPickView
#selectView:
changed:
#menu
#openInPickMode
#selectFocusView
#toolbarMenu

when clicking, select the clicked view;
always show a view's name.
cg@2748
     1
"
cg@2748
     2
 COPYRIGHT (c) 2007 by eXept Software AG
cg@2748
     3
              All Rights Reserved
cg@2748
     4
cg@2748
     5
 This software is furnished under a license and may be used
cg@2748
     6
 only in accordance with the terms of that license and with the
cg@2748
     7
 inclusion of the above copyright notice.   This software may not
cg@2748
     8
 be provided or otherwise made available to, or used by, any
cg@2748
     9
 other person.  No title to or ownership of the software is
cg@2748
    10
 hereby transferred.
cg@2748
    11
"
ca@2177
    12
"{ Package: 'stx:libtool2' }"
ca@2177
    13
ca@2177
    14
"{ NameSpace: Tools }"
ca@2177
    15
cg@2744
    16
ToolApplicationModel subclass:#ViewTreeInspectorApplication
ca@2177
    17
	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
ca@2458
    18
		motionAction process followFocusChannel showNamesHolder'
ca@2177
    19
	classVariableNames:''
ca@2177
    20
	poolDictionaries:''
cg@2744
    21
	category:'Interface-Smalltalk'
ca@2177
    22
!
ca@2177
    23
ca@2177
    24
Object subclass:#MenuDesc
ca@2177
    25
	instanceVariableNames:'title value action'
ca@2177
    26
	classVariableNames:''
ca@2177
    27
	poolDictionaries:''
cg@2744
    28
	privateIn:ViewTreeInspectorApplication
ca@2177
    29
!
ca@2177
    30
cg@2744
    31
HierarchicalItem subclass:#ViewTreeItem
cg@2744
    32
	instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
cg@2744
    33
	classVariableNames:'HandleExtent'
cg@2744
    34
	poolDictionaries:''
cg@2744
    35
	privateIn:ViewTreeInspectorApplication
cg@2744
    36
!
cg@2744
    37
cg@2744
    38
ValueModel subclass:#ViewTreeModel
cg@2744
    39
	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
cg@2744
    40
		inputEventAction mappedViewAction beforeSelectionChangedAction
cg@2744
    41
		icons timedUpdateTask selectOnClickHolder testModeChannel
cg@2744
    42
		hasTargetWidgetChannel'
cg@2744
    43
	classVariableNames:''
cg@2744
    44
	poolDictionaries:''
cg@2744
    45
	privateIn:ViewTreeInspectorApplication
cg@2744
    46
!
cg@2744
    47
cg@2744
    48
HierarchicalList subclass:#ItemList
cg@2744
    49
	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
cg@2744
    50
	classVariableNames:''
cg@2744
    51
	poolDictionaries:''
cg@2744
    52
	privateIn:ViewTreeInspectorApplication::ViewTreeModel
cg@2744
    53
!
cg@2744
    54
cg@2744
    55
!ViewTreeInspectorApplication class methodsFor:'documentation'!
ca@2177
    56
cg@2748
    57
copyright
cg@2748
    58
"
cg@2748
    59
 COPYRIGHT (c) 2007 by eXept Software AG
cg@2748
    60
              All Rights Reserved
cg@2748
    61
cg@2748
    62
 This software is furnished under a license and may be used
cg@2748
    63
 only in accordance with the terms of that license and with the
cg@2748
    64
 inclusion of the above copyright notice.   This software may not
cg@2748
    65
 be provided or otherwise made available to, or used by, any
cg@2748
    66
 other person.  No title to or ownership of the software is
cg@2748
    67
 hereby transferred.
cg@2748
    68
"
cg@2748
    69
!
cg@2748
    70
ca@2177
    71
documentation
ca@2177
    72
"
ca@2177
    73
     Small application showing a ViewTreeModel use.
ca@2177
    74
ca@2177
    75
     It displays a hierarchical list of a selected TopView and
ca@2177
    76
     all its contained subViews.
ca@2177
    77
     Useful to have a look at subcomponents - to see how views
ca@2177
    78
     are structured.
ca@2177
    79
ca@2177
    80
ca@2177
    81
    [Instance variables:]
ca@2177
    82
        model           <ViewTreeModel>      the used ViewTreeModel
ca@2177
    83
        clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
ca@2177
    84
        clickedPoint    <Point>              point where the motion action started from.
ca@2177
    85
        motionAction    <Action>             (oneArg-) action called durring buttonMotion.
ca@2177
    86
ca@2177
    87
ca@2177
    88
    [author:]
ca@2177
    89
        Claus Atzkern
ca@2177
    90
ca@2177
    91
    [see also:]
ca@2177
    92
        ViewTreeModel
ca@2177
    93
        ViewTreeItem
ca@2177
    94
"
ca@2177
    95
! !
ca@2177
    96
cg@2744
    97
!ViewTreeInspectorApplication class methodsFor:'initialization'!
ca@2177
    98
ca@2177
    99
initialize
ca@2177
   100
    "add myself to the launcher menu
ca@2177
   101
    "
ca@2177
   102
    self installInLauncher.
ca@2177
   103
!
ca@2177
   104
ca@2177
   105
installInLauncher
cg@2744
   106
    "add myself to the launcher menu"
cg@2744
   107
ca@2177
   108
    |menuItem icon|
ca@2177
   109
ca@2177
   110
    NewLauncher isNil ifTrue:[^ self].
cg@2744
   111
    "/ cg - disabled. the icon is too ugly.
cg@2744
   112
    ^ self.
ca@2177
   113
ca@2177
   114
    icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
ca@2177
   115
ca@2177
   116
    menuItem := MenuItem new 
cg@2744
   117
                    label: 'View Tree Inspector';
cg@2744
   118
                    value: [ ViewTreeInspectorApplication open];
ca@2177
   119
                    isButton: true;
ca@2177
   120
                    icon: icon;
ca@2177
   121
                    nameKey: #viewInspect.
ca@2177
   122
ca@2177
   123
    menuItem startGroup:#right.
ca@2177
   124
    NewLauncher addMenuItem:menuItem in:'toolbar'
ca@2177
   125
                   position:#( #before #help)
ca@2177
   126
                      space:false.
ca@2177
   127
ca@2177
   128
"
ca@2177
   129
self installInLauncher
ca@2177
   130
self removeFromLauncher
ca@2177
   131
"
ca@2177
   132
!
ca@2177
   133
ca@2177
   134
postAutoload
ca@2177
   135
    "add myself to the launcher menu
ca@2177
   136
    "
ca@2177
   137
    self installInLauncher.
ca@2177
   138
"
ca@2177
   139
self installInLauncher
ca@2177
   140
self removeFromLauncher
ca@2177
   141
"
ca@2177
   142
!
ca@2177
   143
ca@2177
   144
removeFromLauncher
ca@2177
   145
    "remove myself from the launcher menu
ca@2177
   146
    "
ca@2177
   147
    NewLauncher isNil ifTrue:[^ self].
ca@2177
   148
    NewLauncher removeUserTool:#viewInspect
ca@2177
   149
ca@2177
   150
"
ca@2177
   151
self installInLauncher
ca@2177
   152
self removeFromLauncher
ca@2177
   153
"
ca@2177
   154
!
ca@2177
   155
ca@2177
   156
unload
ca@2177
   157
    "class is about to be unloaded - remove myself from the launcher menu
ca@2177
   158
    "
ca@2177
   159
    self removeFromLauncher.
ca@2177
   160
    super unload.
ca@2177
   161
! !
ca@2177
   162
cg@2744
   163
!ViewTreeInspectorApplication class methodsFor:'image specs'!
cg@2744
   164
cg@2759
   165
crossHairIcon
cg@2759
   166
    "This resource specification was automatically generated
cg@2759
   167
     by the ImageEditor of ST/X."
cg@2759
   168
cg@2759
   169
    "Do not manually edit this!! If it is corrupted,
cg@2759
   170
     the ImageEditor may not be able to read the specification."
cg@2759
   171
cg@2759
   172
    "
cg@2759
   173
     self crossHairIcon inspect
cg@2759
   174
     ImageEditor openOnClass:self andSelector:#crossHairIcon
cg@2759
   175
     Icon flushCachedIcons
cg@2759
   176
    "
cg@2759
   177
cg@2759
   178
    <resource: #image>
cg@2759
   179
cg@2759
   180
    ^Icon
cg@2759
   181
        constantNamed:'Tools::ViewTreeInspectorApplication class crossHairIcon'
cg@2759
   182
        ifAbsentPut:[(Depth1Image new) width: 24; height: 24; photometric:(#palette); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@F0@@XL@@>>@A8O@A>?@B,Z B(J @@@@B(J B,Z A>?@A8O@@>>@@XL@@F0@@@@@@@@@@@@@@@@@@@@@') ; colorMapFromArray:#[255 255 255 0 0 0]; mask:((Depth1Image new) width: 24; height: 24; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@G0@@_<@@?>@A??@C?? C?? G??0G<_0G<_0G<_0G??0C?? C?? A??@@?>@@_<@@G0@@@@@@@@@@@@@@@@@') ; yourself); yourself]
cg@2759
   183
!
cg@2759
   184
cg@2744
   185
pickWindowIcon
cg@2744
   186
    "This resource specification was automatically generated
cg@2744
   187
     by the ImageEditor of ST/X."
cg@2744
   188
cg@2744
   189
    "Do not manually edit this!! If it is corrupted,
cg@2744
   190
     the ImageEditor may not be able to read the specification."
cg@2744
   191
cg@2744
   192
    "
cg@2744
   193
     self pickWindowIcon inspect
cg@2744
   194
     ImageEditor openOnClass:self andSelector:#pickWindowIcon
cg@2744
   195
     Icon flushCachedIcons
cg@2744
   196
    "
cg@2744
   197
cg@2744
   198
    <resource: #image>
cg@2744
   199
cg@2744
   200
    ^Icon
cg@2744
   201
        constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
cg@2744
   202
        ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
cg@2744
   203
,;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
cg@2744
   204
,;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
cg@2744
   205
,;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@
cg@2744
   206
-@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@
cg@2744
   207
@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
cg@2744
   208
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]
cg@2759
   209
!
cg@2759
   210
cg@2759
   211
pickWindowIcon2
cg@2759
   212
    "This resource specification was automatically generated
cg@2759
   213
     by the ImageEditor of ST/X."
cg@2759
   214
cg@2759
   215
    "Do not manually edit this!! If it is corrupted,
cg@2759
   216
     the ImageEditor may not be able to read the specification."
cg@2759
   217
cg@2759
   218
    "
cg@2759
   219
     self pickWindowIcon2 inspect
cg@2759
   220
     ImageEditor openOnClass:self andSelector:#pickWindowIcon2
cg@2759
   221
     Icon flushCachedIcons
cg@2759
   222
    "
cg@2759
   223
cg@2759
   224
    <resource: #image>
cg@2759
   225
cg@2759
   226
    ^Icon
cg@2759
   227
        constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon2'
cg@2759
   228
        ifAbsentPut:[(Depth8Image new) width: 22; height: 23; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
cg@2759
   229
@CH<O#,7MB0#HA8\F!!XUD!!DMC@,F@P@<[&U!!W5]MRTH:LRD]FQPPB $IA0H@QF)+XU=WR4Y@M",_F1\TD@(IBP E@D23,;N3,;N3,;N3,;N"'')*X%IJ[F@A^
cg@2759
   230
,;N3,;N3,0@@@@@@():Z&IRR&3@@W+N3,;N3@@B3,0B3)@@@&)"T$),0@E63,;N3@KN3@@@@@@B"'' BX%IJWK0A\,;N3@KN3,;N3@JR"'')*X@IRR&24@V+N3
cg@2759
   231
@KN3,;L@@@@@@I:Z&IP@$),*@E&3,0B3,;N3,:P@():Z&IRT@IJ[J@AX,0B3@KL@,;L@@@B^& BT@IP@&2X@U+L@,0B3@KL@)JJ^@I @%@BT@I,%@EV3@@@@
cg@2759
   232
@@@@@JR"'' @@@@@@@@B[I@AT,0B3@KL@)@B$()8@&@BZ@IP@&2H@T;L@,0B3@JR$@@@@%I @& BT@I,"@EJ3,0B3,:R$)I8@&IRX%I*X@IJ[H AQ,;L@,:R$
cg@2759
   233
)@@@@@@@&IRO#0BO RH@S;N3,0B$)JR"'' BX%I"T#0BO#7<"@D:-,;N$@JR$@@@@@@BR#0BO#8=>H AN+[N$)JH@@I"T@I"T@@BO#8>O_"H@JZ63)JJ^&) @
cg@2759
   234
@@@@@IJO#8>O#8@O@B&3,;N3,;N3,;N3,;N"'')*X%IJ[C0@)R$]EPS<=NS 5L28''H"H"H"H"H <b') ; 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]; mask:((Depth1Image new) width: 22; height: 23; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<') ; yourself); yourself]
cg@2744
   235
! !
cg@2744
   236
cg@2744
   237
!ViewTreeInspectorApplication class methodsFor:'interface specs'!
ca@2177
   238
ca@2177
   239
windowSpec
ca@2177
   240
    "This resource specification was automatically generated
ca@2177
   241
     by the UIPainter of ST/X."
ca@2177
   242
ca@2177
   243
    "Do not manually edit this!! If it is corrupted,
ca@2177
   244
     the UIPainter may not be able to read the specification."
ca@2177
   245
ca@2177
   246
    "
cg@2757
   247
     UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec
cg@2757
   248
     Tools::ViewTreeInspectorApplication new openInterface:#windowSpec
cg@2757
   249
     Tools::ViewTreeInspectorApplication open
ca@2177
   250
    "
ca@2177
   251
ca@2177
   252
    <resource: #canvas>
ca@2177
   253
ca@2177
   254
    ^ 
ca@2177
   255
     #(FullSpec
ca@2177
   256
        name: windowSpec
ca@2177
   257
        window: 
ca@2177
   258
       (WindowSpec
cg@2744
   259
          label: 'View Tree Inspector'
cg@2757
   260
          name: 'View Tree Inspector'
ca@2177
   261
          min: (Point 10 10)
ca@2177
   262
          max: (Point 1024 9999)
ca@2451
   263
          bounds: (Rectangle 0 0 381 654)
ca@2177
   264
          menu: menu
ca@2177
   265
        )
ca@2177
   266
        component: 
ca@2177
   267
       (SpecCollection
ca@2177
   268
          collection: (
ca@2177
   269
           (MenuPanelSpec
ca@2177
   270
              name: 'toolbarMenu'
cg@2757
   271
              layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
ca@2177
   272
              menu: toolbarMenu
ca@2177
   273
              textDefault: true
ca@2177
   274
            )
ca@2177
   275
           (HierarchicalListViewSpec
ca@2177
   276
              name: 'List'
cg@2757
   277
              layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
ca@2177
   278
              level: 1
ca@2177
   279
              model: model
ca@2177
   280
              menu: middleButtonMenu
ca@2177
   281
              hasHorizontalScrollBar: true
ca@2177
   282
              hasVerticalScrollBar: true
ca@2177
   283
              miniScrollerHorizontal: true
ca@2177
   284
              miniScrollerVertical: false
ca@2177
   285
              listModel: listOfItems
ca@2177
   286
              multipleSelectOk: true
ca@2177
   287
              useIndex: false
ca@2177
   288
              highlightMode: label
ca@2177
   289
              showLeftIndicators: false
ca@2177
   290
              indicatorSelector: indicatorClicked:
ca@2177
   291
              useDefaultIcons: false
ca@2177
   292
              postBuildCallback: postBuildTree:
ca@2177
   293
            )
ca@2177
   294
           )
ca@2177
   295
         
ca@2177
   296
        )
ca@2177
   297
      )
ca@2177
   298
! !
ca@2177
   299
cg@2744
   300
!ViewTreeInspectorApplication class methodsFor:'menu specs'!
ca@2177
   301
ca@2177
   302
menu
ca@2177
   303
    "This resource specification was automatically generated
ca@2177
   304
     by the MenuEditor of ST/X."
ca@2177
   305
ca@2177
   306
    "Do not manually edit this!! If it is corrupted,
ca@2177
   307
     the MenuEditor may not be able to read the specification."
ca@2177
   308
ca@2177
   309
    "
ca@2454
   310
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
ca@2454
   311
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
ca@2177
   312
    "
ca@2177
   313
ca@2177
   314
    <resource: #menu>
ca@2177
   315
ca@2177
   316
    ^ 
ca@2177
   317
     #(Menu
ca@2177
   318
        (
ca@2177
   319
         (MenuItem
ca@2177
   320
            label: 'File'
ca@2177
   321
            translateLabel: true
ca@2177
   322
            submenu: 
ca@2177
   323
           (Menu
ca@2177
   324
              (
ca@2177
   325
               (MenuItem
ca@2177
   326
                  label: 'Pick a View'
cg@2762
   327
                  itemValue: doPickView
ca@2177
   328
                  translateLabel: true
ca@2177
   329
                )
ca@2177
   330
               (MenuItem
ca@2455
   331
                  enabled: hasTargetWidgetChannel
ca@2177
   332
                  label: 'Release Picked View'
ca@2177
   333
                  itemValue: doUnpick
ca@2177
   334
                  translateLabel: true
ca@2177
   335
                )
ca@2177
   336
               (MenuItem
ca@2177
   337
                  label: '-'
ca@2177
   338
                )
ca@2177
   339
               (MenuItem
cg@2744
   340
                  label: 'Settings'
cg@2744
   341
                  translateLabel: true
cg@2744
   342
                  submenu: 
cg@2744
   343
                 (Menu
cg@2744
   344
                    (
cg@2744
   345
                     (MenuItem
cg@2744
   346
                        label: 'Test Mode'
cg@2744
   347
                        translateLabel: true
cg@2744
   348
                        hideMenuOnActivated: false
cg@2744
   349
                        indication: testModeChannel
cg@2744
   350
                      )
cg@2744
   351
                     (MenuItem
cg@2744
   352
                        enabled: testModeChannel
cg@2744
   353
                        label: 'Follow Focus'
cg@2744
   354
                        translateLabel: true
cg@2744
   355
                        hideMenuOnActivated: false
cg@2744
   356
                        indication: followFocusChannel
cg@2744
   357
                      )
cg@2744
   358
                     (MenuItem
cg@2744
   359
                        label: '-'
cg@2744
   360
                      )
cg@2744
   361
                     (MenuItem
cg@2744
   362
                        label: 'Select on Click'
cg@2744
   363
                        translateLabel: true
cg@2744
   364
                        hideMenuOnActivated: false
cg@2744
   365
                        indication: selectOnClickHolder
cg@2744
   366
                      )
cg@2744
   367
                     (MenuItem
cg@2744
   368
                        label: '-'
cg@2744
   369
                      )
cg@2744
   370
                     (MenuItem
cg@2744
   371
                        label: 'Show Name of Widgets'
cg@2744
   372
                        translateLabel: true
cg@2744
   373
                        hideMenuOnActivated: false
cg@2744
   374
                        indication: showNamesHolder
cg@2744
   375
                      )
cg@2744
   376
                     )
cg@2744
   377
                    nil
cg@2744
   378
                    nil
cg@2744
   379
                  )
cg@2744
   380
                )
cg@2744
   381
               (MenuItem
cg@2744
   382
                  label: '-'
cg@2744
   383
                )
cg@2744
   384
               (MenuItem
ca@2177
   385
                  label: 'Exit'
ca@2177
   386
                  itemValue: closeRequest
ca@2177
   387
                  translateLabel: true
ca@2177
   388
                )
ca@2177
   389
               )
ca@2177
   390
              nil
ca@2177
   391
              nil
ca@2177
   392
            )
ca@2177
   393
          )
ca@2177
   394
         (MenuItem
cg@2744
   395
            enabled: hasSingleSelectionHolder
cg@2744
   396
            label: 'Selection'
cg@2744
   397
            translateLabel: true
cg@2744
   398
            submenuChannel: middleButtonMenu
cg@2744
   399
          )
cg@2744
   400
         (MenuItem
cg@2744
   401
            label: 'Application'
ca@2454
   402
            translateLabel: true
ca@2454
   403
            submenu: 
ca@2454
   404
           (Menu
ca@2454
   405
              (
ca@2454
   406
               (MenuItem
cg@2744
   407
                  enabled: hasSingleSelectionHolder
cg@2744
   408
                  label: 'Browse'
cg@2744
   409
                  itemValue: doBrowse:
ca@2454
   410
                  translateLabel: true
cg@2744
   411
                  argument: application
ca@2454
   412
                )
ca@2454
   413
               (MenuItem
cg@2744
   414
                  enabled: hasSingleSelectionHolder
cg@2744
   415
                  label: 'Inspect'
cg@2744
   416
                  itemValue: doInspect:
ca@2454
   417
                  translateLabel: true
cg@2744
   418
                  argument: application
ca@2454
   419
                )
ca@2454
   420
               (MenuItem
ca@2454
   421
                  label: '-'
ca@2454
   422
                )
ca@2454
   423
               (MenuItem
cg@2744
   424
                  enabled: hasTargetWidgetChannel
cg@2744
   425
                  label: 'All Applications'
ca@2454
   426
                  translateLabel: true
cg@2744
   427
                  submenuChannel: submenuApplications:
cg@2744
   428
                )
cg@2744
   429
               )
cg@2744
   430
              nil
cg@2744
   431
              nil
cg@2744
   432
            )
cg@2744
   433
          )
cg@2744
   434
         (MenuItem
cg@2744
   435
            label: 'Widget'
cg@2744
   436
            translateLabel: true
cg@2744
   437
            submenu: 
cg@2744
   438
           (Menu
cg@2744
   439
              (
cg@2744
   440
               (MenuItem
cg@2744
   441
                  enabled: hasSingleSelectionHolder
cg@2744
   442
                  label: 'Browse'
cg@2744
   443
                  itemValue: doBrowse:
cg@2744
   444
                  translateLabel: true
cg@2744
   445
                  argument: view
cg@2744
   446
                )
cg@2744
   447
               (MenuItem
cg@2744
   448
                  enabled: hasSingleSelectionHolder
cg@2744
   449
                  label: 'Inspect'
cg@2744
   450
                  itemValue: doInspect:
cg@2744
   451
                  translateLabel: true
cg@2744
   452
                  argument: view
ca@2454
   453
                )
ca@2454
   454
               (MenuItem
ca@2454
   455
                  label: '-'
ca@2454
   456
                )
ca@2454
   457
               (MenuItem
cg@2744
   458
                  enabled: hasTargetWidgetChannel
cg@2744
   459
                  label: 'All Components'
ca@2454
   460
                  translateLabel: true
cg@2744
   461
                  startGroup: right
cg@2744
   462
                  submenuChannel: submenuComponents:
ca@2454
   463
                )
ca@2454
   464
               )
ca@2454
   465
              nil
ca@2454
   466
              nil
ca@2454
   467
            )
ca@2454
   468
          )
ca@2454
   469
         (MenuItem
cg@2744
   470
            label: 'Help'
ca@2177
   471
            translateLabel: true
cg@2744
   472
            startGroup: conditionalRight
cg@2744
   473
            submenu: 
cg@2744
   474
           (Menu
cg@2744
   475
              (
cg@2744
   476
               (MenuItem
cg@2744
   477
                  label: 'Documentation'
cg@2744
   478
                  itemValue: openDocumentation
cg@2744
   479
                  translateLabel: true
cg@2744
   480
                )
cg@2744
   481
               (MenuItem
cg@2744
   482
                  label: '-'
cg@2744
   483
                )
cg@2744
   484
               (MenuItem
cg@2744
   485
                  label: 'About this Application...'
cg@2744
   486
                  itemValue: openAboutThisApplication
cg@2744
   487
                  translateLabel: true
cg@2744
   488
                )
cg@2744
   489
               )
cg@2744
   490
              nil
cg@2744
   491
              nil
cg@2744
   492
            )
ca@2177
   493
          )
ca@2177
   494
         )
ca@2177
   495
        nil
ca@2177
   496
        nil
ca@2177
   497
      )
ca@2177
   498
!
ca@2177
   499
ca@2177
   500
middleButtonMenu
ca@2177
   501
    "This resource specification was automatically generated
ca@2177
   502
     by the MenuEditor of ST/X."
ca@2177
   503
ca@2177
   504
    "Do not manually edit this!! If it is corrupted,
ca@2177
   505
     the MenuEditor may not be able to read the specification."
ca@2177
   506
ca@2177
   507
    "
ca@2177
   508
     MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
ca@2177
   509
     (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
ca@2177
   510
    "
ca@2177
   511
ca@2177
   512
    <resource: #menu>
ca@2177
   513
ca@2177
   514
    ^ 
ca@2177
   515
     #(Menu
ca@2177
   516
        (
ca@2177
   517
         (MenuItem
ca@2177
   518
            label: 'Geometry'
ca@2177
   519
            translateLabel: true
ca@2177
   520
            submenuChannel: submenuGeometry:
ca@2177
   521
            keepLinkedMenu: true
ca@2177
   522
          )
ca@2177
   523
         (MenuItem
ca@2177
   524
            label: 'Interface'
ca@2177
   525
            translateLabel: true
ca@2177
   526
            submenuChannel: submenuInterface:
ca@2177
   527
            keepLinkedMenu: true
ca@2177
   528
          )
ca@2177
   529
         (MenuItem
ca@2177
   530
            label: 'Visibility'
ca@2177
   531
            translateLabel: true
ca@2177
   532
            submenuChannel: submenuVisibility:
ca@2177
   533
            keepLinkedMenu: true
ca@2177
   534
          )
ca@2177
   535
         (MenuItem
ca@2177
   536
            label: '-'
ca@2177
   537
          )
ca@2177
   538
         (MenuItem
ca@2177
   539
            label: 'Browse View Class'
ca@2177
   540
            itemValue: doBrowse:
ca@2177
   541
            translateLabel: true
ca@2177
   542
            argument: view
ca@2177
   543
          )
ca@2177
   544
         (MenuItem
ca@2177
   545
            label: 'Browse Model Class'
ca@2177
   546
            itemValue: doBrowse:
ca@2177
   547
            translateLabel: true
ca@2177
   548
            isVisible: hasModel
ca@2177
   549
            argument: model
ca@2177
   550
          )
ca@2177
   551
         (MenuItem
ca@2177
   552
            label: 'Browse Application Class'
ca@2177
   553
            itemValue: doBrowse:
ca@2177
   554
            translateLabel: true
ca@2177
   555
            isVisible: hasApplication
ca@2177
   556
            argument: application
ca@2177
   557
          )
ca@2177
   558
         (MenuItem
ca@2177
   559
            label: 'Browse Controller Class'
ca@2177
   560
            itemValue: doBrowse:
ca@2177
   561
            translateLabel: true
ca@2177
   562
            isVisible: hasController
ca@2177
   563
            argument: controller
ca@2177
   564
          )
ca@2177
   565
         (MenuItem
ca@2177
   566
            label: '-'
ca@2177
   567
          )
ca@2177
   568
         (MenuItem
ca@2177
   569
            label: 'Inspect View'
ca@2177
   570
            itemValue: doInspect:
ca@2177
   571
            translateLabel: true
ca@2177
   572
            argument: view
ca@2177
   573
          )
ca@2177
   574
         (MenuItem
ca@2177
   575
            label: 'Inspect Window Group'
ca@2177
   576
            itemValue: doInspect:
ca@2177
   577
            translateLabel: true
ca@2177
   578
            argument: group
ca@2177
   579
          )
ca@2177
   580
         (MenuItem
ca@2177
   581
            label: 'Inspect Model'
ca@2177
   582
            itemValue: doInspect:
ca@2177
   583
            translateLabel: true
ca@2177
   584
            isVisible: hasModel
ca@2177
   585
            argument: model
ca@2177
   586
          )
ca@2177
   587
         (MenuItem
ca@2177
   588
            label: 'Inspect Application'
ca@2177
   589
            itemValue: doInspect:
ca@2177
   590
            translateLabel: true
ca@2177
   591
            isVisible: hasApplication
ca@2177
   592
            argument: application
ca@2177
   593
          )
ca@2177
   594
         (MenuItem
ca@2177
   595
            label: 'Inspect Controller'
ca@2177
   596
            itemValue: doInspect:
ca@2177
   597
            translateLabel: true
ca@2177
   598
            isVisible: hasController
ca@2177
   599
            argument: controller
ca@2177
   600
          )
ca@2177
   601
         (MenuItem
ca@2177
   602
            label: '-'
ca@2177
   603
          )
ca@2177
   604
         (MenuItem
ca@2177
   605
            label: 'Flash'
ca@2177
   606
            itemValue: doFlash
ca@2177
   607
            translateLabel: true
ca@2177
   608
          )
ca@2177
   609
         (MenuItem
ca@2177
   610
            label: '-'
ca@2177
   611
          )
ca@2177
   612
         (MenuItem
ca@2177
   613
            label: 'Destroy'
ca@2177
   614
            itemValue: doDestroy
ca@2177
   615
            translateLabel: true
ca@2177
   616
          )
ca@2177
   617
         (MenuItem
ca@2177
   618
            label: '-'
ca@2177
   619
          )
ca@2177
   620
         (MenuItem
ca@2177
   621
            label: 'Instance Variables'
ca@2177
   622
            translateLabel: true
ca@2177
   623
            submenuChannel: submenuInspector:
ca@2177
   624
            keepLinkedMenu: true
ca@2177
   625
          )
ca@2177
   626
         (MenuItem
ca@2177
   627
            label: '='
ca@2177
   628
          )
ca@2177
   629
         (MenuItem
ca@2177
   630
            label: ''
ca@2177
   631
          )
ca@2177
   632
         (MenuItem
ca@2177
   633
            enabled: selectedComponentHasChildren
ca@2177
   634
            label: 'Applications'
ca@2177
   635
            nameKey: single
ca@2177
   636
            translateLabel: true
ca@2177
   637
            submenuChannel: submenuApplications:
ca@2177
   638
            keepLinkedMenu: true
ca@2177
   639
          )
ca@2177
   640
         (MenuItem
ca@2177
   641
            enabled: selectedComponentHasChildren
ca@2177
   642
            label: 'Components'
ca@2177
   643
            nameKey: single
ca@2177
   644
            translateLabel: true
ca@2177
   645
            submenuChannel: submenuComponents:
ca@2177
   646
            keepLinkedMenu: true
ca@2177
   647
          )
ca@2177
   648
         )
ca@2177
   649
        nil
ca@2177
   650
        nil
ca@2177
   651
      )
ca@2177
   652
!
ca@2177
   653
ca@2177
   654
toolbarMenu
ca@2177
   655
    "This resource specification was automatically generated
ca@2177
   656
     by the MenuEditor of ST/X."
ca@2177
   657
ca@2177
   658
    "Do not manually edit this!! If it is corrupted,
ca@2177
   659
     the MenuEditor may not be able to read the specification."
ca@2177
   660
ca@2177
   661
    "
cg@2757
   662
     MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu
cg@2757
   663
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp
ca@2177
   664
    "
ca@2177
   665
ca@2177
   666
    <resource: #menu>
ca@2177
   667
ca@2177
   668
    ^ 
ca@2177
   669
     #(Menu
ca@2177
   670
        (
ca@2177
   671
         (MenuItem
cg@2744
   672
            label: 'Pick a View'
cg@2762
   673
            itemValue: doPickView
cg@2744
   674
            translateLabel: false
cg@2744
   675
            isButton: true
cg@2744
   676
            hideMenuOnActivated: false
cg@2759
   677
            labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon2)
cg@2744
   678
          )
cg@2744
   679
         (MenuItem
cg@2757
   680
            enabled: hasTargetWidgetChannel
cg@2757
   681
            label: 'Release Picked View'
cg@2757
   682
            isButton: true
cg@2757
   683
            itemValue: doUnpick
cg@2757
   684
            translateLabel: true
cg@2757
   685
            labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
cg@2757
   686
          )
cg@2757
   687
         (MenuItem
cg@2757
   688
            label: '-'
cg@2757
   689
          )
cg@2757
   690
         (MenuItem
ca@2454
   691
            enabled: hasSingleSelectionHolder
cg@2744
   692
            label: 'Browse Application'
ca@2454
   693
            itemValue: doBrowse:
ca@2454
   694
            translateLabel: false
cg@2744
   695
            isButton: true
cg@2744
   696
            hideMenuOnActivated: false
ca@2454
   697
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454
   698
            argument: application
ca@2177
   699
          )
ca@2177
   700
         (MenuItem
ca@2454
   701
            enabled: hasSingleSelectionHolder
cg@2744
   702
            label: 'Inspect Application'
ca@2454
   703
            itemValue: doInspect:
ca@2454
   704
            translateLabel: false
cg@2744
   705
            isButton: true
cg@2744
   706
            hideMenuOnActivated: false
cg@2744
   707
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
ca@2454
   708
            argument: application
ca@2177
   709
          )
ca@2177
   710
         )
ca@2177
   711
        nil
ca@2177
   712
        nil
ca@2177
   713
      )
ca@2177
   714
! !
ca@2177
   715
cg@2747
   716
!ViewTreeInspectorApplication class methodsFor:'startup'!
cg@2747
   717
cg@2747
   718
openInPickMode
cg@2747
   719
    |app|
cg@2747
   720
cg@2747
   721
    app := self new.
cg@2747
   722
    app open.
cg@2762
   723
    app doPickView.
cg@2747
   724
! !
cg@2747
   725
cg@2744
   726
!ViewTreeInspectorApplication methodsFor:'actions'!
ca@2177
   727
ca@2177
   728
indicatorClicked:anIndex
ca@2177
   729
    |item sensor|
ca@2177
   730
ca@2177
   731
    item := model listOfItems at:anIndex ifAbsent:nil.
ca@2177
   732
ca@2177
   733
    item notNil ifTrue:[
ca@2177
   734
        (     (sensor := self window sensor) notNil
ca@2177
   735
         and:[(sensor ctrlDown or:[sensor shiftDown])]
ca@2177
   736
        ) ifTrue:[
ca@2177
   737
            item recursiveToggleExpand
ca@2177
   738
        ] ifFalse:[
ca@2177
   739
            item toggleExpand
ca@2177
   740
        ]
ca@2177
   741
    ].
ca@2177
   742
! !
ca@2177
   743
cg@2744
   744
!ViewTreeInspectorApplication methodsFor:'aspects'!
ca@2177
   745
ca@2177
   746
followFocusChannel
ca@2455
   747
    "boolean holder, which indicates whether selection changed dependend on the focus view"
ca@2455
   748
ca@2177
   749
    ^ followFocusChannel
ca@2177
   750
!
ca@2177
   751
ca@2177
   752
hasSingleSelectionHolder
ca@2455
   753
    "boolean holder, true if one item is selected"
ca@2455
   754
ca@2177
   755
    ^ hasSingleSelectionHolder
ca@2177
   756
!
ca@2177
   757
ca@2455
   758
hasTargetWidgetChannel
ca@2455
   759
    "answer the channel which is set to true if a target widget exists"
ca@2455
   760
ca@2455
   761
    ^ model hasTargetWidgetChannel
ca@2455
   762
!
ca@2455
   763
ca@2177
   764
listOfItems
ca@2455
   765
    "returns the hierarchical list of items"
ca@2455
   766
ca@2177
   767
    ^ model listOfItems
ca@2177
   768
!
ca@2177
   769
ca@2177
   770
model
ca@2455
   771
    "returns my selection model, a ViewTreeModel"
ca@2455
   772
ca@2177
   773
    ^ model
ca@2177
   774
!
ca@2177
   775
ca@2177
   776
selectOnClickHolder
ca@2455
   777
    "boolean holder, which indicates whether the selection will change on click"
ca@2455
   778
ca@2177
   779
    ^ model selectOnClickHolder
ca@2177
   780
!
ca@2177
   781
ca@2451
   782
showNamesHolder
ca@2451
   783
    "boolean holder, which indicates whether application names or widget names
ca@2455
   784
     as additional text are shown for the items"
ca@2455
   785
ca@2451
   786
    ^ showNamesHolder
ca@2451
   787
!
ca@2451
   788
ca@2177
   789
testModeChannel
ca@2455
   790
    "answer a boolean channel which describes the behaviour how to process
ca@2455
   791
     events on the target view.
ca@2455
   792
ca@2455
   793
     false: all input events are eaten and the selection is shown on the target view.
ca@2455
   794
     true:  no  input events are eaten and no  selection is shown on the target view."
ca@2455
   795
ca@2455
   796
    ^ model testModeChannel
ca@2177
   797
! !
ca@2177
   798
cg@2744
   799
!ViewTreeInspectorApplication methodsFor:'change & update'!
ca@2177
   800
ca@2177
   801
selectionChanged
ca@2177
   802
    |info view item|
ca@2177
   803
ca@2177
   804
    item := model selectedItem.
ca@2177
   805
ca@2177
   806
    item notNil ifTrue:[ |state|
ca@2177
   807
        view := item widget.
ca@2177
   808
ca@2177
   809
        view id isNil ifTrue:[
ca@2177
   810
            state := 'no ID'.
ca@2177
   811
        ] ifFalse:[
ca@2177
   812
            view shown ifTrue:[
ca@2177
   813
                state := 'visible'.
ca@2177
   814
            ] ifFalse:[
ca@2177
   815
                state := 'invisible'
ca@2177
   816
            ].
ca@2177
   817
        ].
ca@2177
   818
        info := '%1 [%2] - %3' bindWith:(view class name)
ca@2177
   819
                                   with:(view name ? '') with:state allBold.
ca@2177
   820
ca@2177
   821
    ] ifFalse:[
ca@2177
   822
        info := ''
ca@2177
   823
    ].
ca@2177
   824
    hasSingleSelectionHolder value:(view notNil).
ca@2177
   825
!
ca@2177
   826
ca@2177
   827
update:something with:someArgument from:aModel
ca@2454
   828
    |oldSelection|
ca@2454
   829
ca@2451
   830
    aModel == showNamesHolder ifTrue:[
ca@2455
   831
        oldSelection := model selectedItem.
ca@2454
   832
        model selectedItem:nil.
ca@2451
   833
        self listOfItems showWidgetNames:(aModel value).
ca@2454
   834
        model selectedItem:oldSelection.
ca@2451
   835
        ^ self
ca@2451
   836
    ].
ca@2458
   837
ca@2458
   838
    aModel == model ifTrue:[
ca@2458
   839
        self selectionChanged.
ca@2458
   840
        ^ self
ca@2458
   841
    ].
ca@2458
   842
ca@2177
   843
    super update:something with:someArgument from:aModel.
ca@2177
   844
! !
ca@2177
   845
cg@2744
   846
!ViewTreeInspectorApplication methodsFor:'event processing'!
ca@2177
   847
ca@2177
   848
processButtonMotionEvent:ev
ca@2455
   849
    |click rootView|
ca@2177
   850
ca@2455
   851
    motionAction isNil ifTrue:[^ self].
ca@2455
   852
ca@2455
   853
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   854
        clickedItem := motionAction := nil.
ca@2455
   855
        ^ self
ca@2455
   856
    ].
ca@2455
   857
ca@2455
   858
    click := rootView device
ca@2455
   859
            translatePoint:((ev x)@ (ev y))
ca@2455
   860
            fromView:(ev view)
ca@2455
   861
            toView:rootView.
ca@2455
   862
ca@2455
   863
    click = clickedPoint ifFalse:[
ca@2455
   864
        (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
ca@2455
   865
            motionAction value:click
ca@2177
   866
        ]
ca@2177
   867
    ].
ca@2177
   868
!
ca@2177
   869
ca@2177
   870
processButtonPressEvent:ev
ca@2455
   871
    |rootView sensor lastRectangle|
ca@2455
   872
ca@2455
   873
    rootView    := model rootView.
ca@2177
   874
    sensor      := model rootView sensor.
ca@2177
   875
    clickedItem := model listOfItems detectItemRespondsToView:(ev view).
ca@2177
   876
ca@2177
   877
    (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
ca@2177
   878
        clickedItem notNil ifTrue:[
ca@2177
   879
            self selectOnClickHolder value ifTrue:[
ca@2177
   880
                model toggleSelectItem:clickedItem
ca@2177
   881
            ].
ca@2177
   882
        ].
ca@2177
   883
        clickedItem := motionAction := nil.
ca@2455
   884
        ^ self
ca@2455
   885
    ].
ca@2177
   886
ca@2455
   887
    clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
ca@2455
   888
    lastRectangle := nil.
ca@2177
   889
ca@2455
   890
    motionAction :=[:p|
ca@2455
   891
        rootView    := model rootView device rootView.
ca@2455
   892
        rootView    := model rootView.
ca@2455
   893
        clickedItem := nil.
ca@2177
   894
ca@2455
   895
        rootView xoring:[
ca@2455
   896
            lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
ca@2455
   897
                                ifFalse:[ rootView clippedByChildren:false ].
ca@2455
   898
ca@2455
   899
            p isNil ifTrue:[
ca@2455
   900
                rootView clippedByChildren:true.
ca@2455
   901
                motionAction := nil.
ca@2455
   902
            ] ifFalse:[
ca@2455
   903
                lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
ca@2455
   904
                rootView displayRectangle:lastRectangle.
ca@2177
   905
            ].
ca@2455
   906
            rootView flush.
ca@2455
   907
        ].
ca@2455
   908
        lastRectangle
ca@2455
   909
    ].
ca@2177
   910
!
ca@2177
   911
ca@2177
   912
processButtonReleaseEvent:anEvent
ca@2177
   913
    |rootView rectangle newItems widget origin|
ca@2177
   914
ca@2455
   915
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   916
        clickedItem := motionAction := nil.
ca@2455
   917
        ^ self
ca@2455
   918
    ].
ca@2177
   919
    motionAction isNil ifTrue:[ ^ self ].
ca@2177
   920
    clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
ca@2177
   921
ca@2455
   922
    rectangle := motionAction value:nil.
ca@2455
   923
    rectangle isNil ifTrue:[^ self].
ca@2177
   924
ca@2455
   925
    newItems := OrderedCollection new.
ca@2177
   926
ca@2455
   927
    model rootItem recursiveDo:[:anItem|
ca@2455
   928
        widget := anItem widget.
ca@2455
   929
        origin := widget originRelativeTo:rootView.
ca@2455
   930
ca@2455
   931
        (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
ca@2455
   932
            newItems add:anItem.
ca@2455
   933
        ]
ca@2177
   934
    ].
ca@2455
   935
    model value:newItems.
ca@2177
   936
!
ca@2177
   937
ca@2177
   938
processEvent:anEvent
ca@2177
   939
    |button menu|
ca@2177
   940
cg@2758
   941
    anEvent isKeyPressEvent ifTrue:[ self processKeyPressEvent:anEvent. ^ self  ].
ca@2177
   942
    anEvent isButtonEvent  ifFalse:[ ^ self ].
ca@2177
   943
ca@2177
   944
    button := anEvent button.
ca@2177
   945
ca@2177
   946
    (button == 2 or:[button == #menu]) ifTrue:[
ca@2177
   947
        motionAction isNil ifTrue:[
ca@2177
   948
            anEvent isButtonPressEvent ifTrue:[
ca@2177
   949
                self selectOnClickHolder value ifTrue:[
ca@2177
   950
                    menu := self middleButtonMenu value.
ca@2177
   951
                    menu notNil ifTrue:[
cg@2758
   952
                        menu := MenuPanel 
cg@2758
   953
                                    menu:(Menu new fromLiteralArrayEncoding:menu)
cg@2758
   954
                                    receiver:self.
ca@2177
   955
                        menu startUp.
ca@2177
   956
                    ]
ca@2177
   957
                ].
ca@2177
   958
            ].
ca@2177
   959
            clickedItem := nil.
ca@2177
   960
        ].
ca@2177
   961
        ^ self
ca@2177
   962
    ].
ca@2177
   963
cg@2758
   964
    anEvent isButtonPressEvent  ifTrue:[ self processButtonPressEvent:anEvent. ^ self ].
cg@2758
   965
    anEvent isButtonMotionEvent ifTrue:[ self processButtonMotionEvent:anEvent. ^ self ].
ca@2177
   966
ca@2177
   967
    anEvent isButtonReleaseEvent ifTrue:[
ca@2177
   968
        self selectOnClickHolder value ifTrue:[
ca@2177
   969
            self processButtonReleaseEvent:anEvent
ca@2177
   970
        ].
ca@2177
   971
    ].
ca@2177
   972
    clickedItem := motionAction := nil.
ca@2177
   973
ca@2177
   974
    anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
ca@2177
   975
        self selectOnClickHolder value ifTrue:[
ca@2177
   976
            self doInspect:#view.
ca@2177
   977
        ].
ca@2177
   978
    ].
ca@2177
   979
!
ca@2177
   980
ca@2177
   981
processKeyPressEvent:anEvent
ca@2177
   982
    |item prnt idx key max next|
ca@2177
   983
ca@2177
   984
    key := anEvent key.
ca@2177
   985
    key isSymbol ifFalse:[^ self].
ca@2177
   986
ca@2177
   987
    key == #Delete    ifTrue:[ ^ self doDestroy ].
ca@2177
   988
    key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
ca@2177
   989
ca@2177
   990
    (   key == #CursorUp
ca@2177
   991
    or:[key == #CursorDown
ca@2177
   992
    or:[key == #CursorLeft
ca@2177
   993
    or:[key == #CursorRight]]]
ca@2177
   994
    ) ifFalse:[
ca@2177
   995
        ^ self
ca@2177
   996
    ].
ca@2177
   997
    item := model selectedItem.
ca@2177
   998
ca@2177
   999
    item isNil ifTrue:[
ca@2177
  1000
        ^ model selectedItem:(model first ? model rootItem)
ca@2177
  1001
    ].
ca@2177
  1002
ca@2177
  1003
    prnt := item parent.
ca@2177
  1004
    prnt isNil ifTrue:[
ca@2177
  1005
        "/ is the root item
ca@2177
  1006
        (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
ca@2177
  1007
                                                  ifFalse:[item := item at:1 ifAbsent:item].
ca@2177
  1008
cg@2758
  1009
        ^ model selectedItem:item
ca@2177
  1010
    ].
ca@2177
  1011
    key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
ca@2177
  1012
ca@2177
  1013
    key == #CursorRight ifTrue:[
ca@2177
  1014
        next := item at:1 ifAbsent:nil.
ca@2177
  1015
        next notNil ifTrue:[ model selectedItem:next ].
cg@2758
  1016
        ^ self
ca@2177
  1017
    ].
ca@2177
  1018
ca@2177
  1019
    max := prnt size.
ca@2177
  1020
ca@2177
  1021
    key == #CursorUp ifTrue:[
ca@2177
  1022
        idx := prnt identityIndexOf:item.
ca@2177
  1023
        idx == 1 ifTrue:[idx := max + 1].
ca@2177
  1024
        model selectedItem:(prnt at:idx - 1).
cg@2758
  1025
        ^ self.
ca@2177
  1026
    ].
ca@2177
  1027
ca@2177
  1028
    key == #CursorDown ifTrue:[
ca@2177
  1029
        idx := prnt identityIndexOf:item.
ca@2177
  1030
        idx == max ifTrue:[idx := 0].
ca@2177
  1031
        model selectedItem:(prnt at:idx + 1).
cg@2758
  1032
        ^ self.
ca@2177
  1033
    ].
ca@2177
  1034
!
ca@2177
  1035
ca@2177
  1036
processMappedView:aView
ca@2177
  1037
    |parent anchor|
ca@2177
  1038
ca@2177
  1039
    parent := self listOfItems detectItemRespondsToView:aView.
ca@2177
  1040
    parent isNil ifTrue:[ ^ self ].
ca@2177
  1041
ca@2177
  1042
    NotFoundSignal handle:[:ex|
ca@2177
  1043
        "contained subvies used by spec are not yet created;
ca@2177
  1044
         thus we have to wait until last used subview is build
ca@2177
  1045
        "
ca@2177
  1046
        anchor := nil.
ca@2177
  1047
    ] do:[
ca@2177
  1048
        anchor := parent class buildViewsFrom:(parent widget).
ca@2177
  1049
    ].
ca@2177
  1050
    anchor notNil ifTrue:[
ca@2177
  1051
        parent updateFromChildren:anchor children.
ca@2177
  1052
    ].
ca@2177
  1053
! !
ca@2177
  1054
cg@2744
  1055
!ViewTreeInspectorApplication methodsFor:'initialization & release'!
ca@2177
  1056
ca@2177
  1057
closeDownViews
ca@2455
  1058
    "release the grapped application"
ca@2455
  1059
ca@2177
  1060
    process := nil.
ca@2177
  1061
    super closeDownViews.
ca@2177
  1062
    self doUnpick.
ca@2177
  1063
!
ca@2177
  1064
ca@2177
  1065
initialize
ca@2455
  1066
    "setup my model and channels"
ca@2455
  1067
ca@2177
  1068
    super initialize.
ca@2177
  1069
ca@2177
  1070
    hasSingleSelectionHolder := false asValue.
ca@2177
  1071
    followFocusChannel       := false asValue.
ca@2177
  1072
ca@2177
  1073
    model := ViewTreeModel new.
ca@2177
  1074
    model inputEventAction:[:ev| self processEvent:ev ].
ca@2177
  1075
    model mappedViewAction:[:vw| self processMappedView:vw ].
ca@2177
  1076
    model application:self.
ca@2458
  1077
    model addDependent:self.
ca@2458
  1078
ca@2177
  1079
ca@2451
  1080
    showNamesHolder := false asValue.
ca@2451
  1081
    showNamesHolder addDependent:self.
ca@2177
  1082
!
ca@2177
  1083
ca@2177
  1084
postBuildTree:aTree
ca@2177
  1085
    treeView := aTree scrolledView.
ca@2177
  1086
    treeView hasConstantHeight:true.
ca@2177
  1087
! !
ca@2177
  1088
cg@2744
  1089
!ViewTreeInspectorApplication methodsFor:'menu queries'!
ca@2177
  1090
ca@2177
  1091
hasApplication
ca@2455
  1092
    "returns true if the current selected view has an application"
ca@2455
  1093
ca@2177
  1094
    |view|
ca@2177
  1095
ca@2177
  1096
    view := self selectedView.
ca@2177
  1097
  ^ (view notNil and:[view application notNil])
ca@2177
  1098
!
ca@2177
  1099
ca@2177
  1100
hasController
ca@2177
  1101
    "returns true if the current selected item's view has a controller
ca@2455
  1102
     other than nil or the view itself"
ca@2455
  1103
ca@2177
  1104
    |view controller|
ca@2177
  1105
ca@2177
  1106
    view := self selectedView.
ca@2177
  1107
ca@2177
  1108
    view notNil ifTrue:[
ca@2177
  1109
        controller := view controller.
ca@2177
  1110
      ^ (controller notNil and:[controller ~~ view])
ca@2177
  1111
    ].
ca@2177
  1112
    ^ false
ca@2177
  1113
!
ca@2177
  1114
ca@2177
  1115
hasModel
ca@2455
  1116
    "returns true if the current selected view has a model"
ca@2455
  1117
ca@2177
  1118
    |view|
ca@2177
  1119
ca@2177
  1120
    view := self selectedView.
ca@2177
  1121
  ^ (view notNil and:[view model notNil])
ca@2177
  1122
! !
ca@2177
  1123
cg@2744
  1124
!ViewTreeInspectorApplication methodsFor:'menu specs'!
ca@2177
  1125
ca@2177
  1126
middleButtonMenu
ca@2455
  1127
    "returns the middleButton menu for the single selected item or nil"
ca@2455
  1128
cg@2758
  1129
    ^ [ 
cg@2758
  1130
        model selectedItem notNil 
cg@2758
  1131
            ifTrue:[self class middleButtonMenu]
cg@2758
  1132
            ifFalse:[nil]
ca@2177
  1133
      ]
ca@2177
  1134
!
ca@2177
  1135
ca@2177
  1136
submenuApplications:aMenu
ca@2177
  1137
    |applications menu item list addBlock|
ca@2177
  1138
ca@2177
  1139
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
  1140
                                              ifFalse:[model rootItem].
ca@2177
  1141
    item isNil ifTrue:[^ nil].
ca@2177
  1142
ca@2177
  1143
    applications := IdentityDictionary new.
ca@2177
  1144
ca@2177
  1145
    addBlock := [:el| |cls ctr|
ca@2177
  1146
        cls := self resolveApplicationClassFor:el.
ca@2177
  1147
ca@2177
  1148
        cls notNil ifTrue:[
ca@2177
  1149
            ctr := applications at:cls ifAbsent:0.
ca@2177
  1150
            applications at:cls put:(ctr + 1).
ca@2177
  1151
        ].
ca@2177
  1152
    ].
ca@2177
  1153
    item recursiveDo:addBlock.
ca@2177
  1154
    addBlock value:item.
ca@2177
  1155
ca@2177
  1156
    applications isEmpty ifTrue:[^ nil ].
ca@2177
  1157
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
  1158
ca@2177
  1159
    applications keysAndValuesDo:[:cls :ctr|
ca@2177
  1160
       list add:(MenuDesc title:(cls name)
ca@2177
  1161
                          value:(ctr printString)
ca@2177
  1162
                         action:[self doSelectNextOfApplicationClass:cls startingIn:item]
ca@2177
  1163
                 ).
ca@2177
  1164
    ].
ca@2177
  1165
ca@2177
  1166
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
  1167
    menu do:[:el|
ca@2177
  1168
        el hideMenuOnActivated:false
ca@2177
  1169
    ].
ca@2177
  1170
    ^ menu
ca@2177
  1171
!
ca@2177
  1172
ca@2177
  1173
submenuComponents:aMenu
ca@2177
  1174
    |widgets list total menu item|
ca@2177
  1175
ca@2177
  1176
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
  1177
                                              ifFalse:[model rootItem].
ca@2177
  1178
    item isNil ifTrue:[^ nil].
ca@2177
  1179
ca@2177
  1180
    widgets := IdentityDictionary new.
ca@2177
  1181
    total   := 0.
ca@2177
  1182
ca@2177
  1183
    item recursiveDo:[:el| |cls ctr|
ca@2177
  1184
        cls := el widget.
ca@2177
  1185
ca@2177
  1186
        cls notNil ifTrue:[
ca@2177
  1187
            cls := cls class.
ca@2177
  1188
            ctr := widgets at:cls ifAbsent:0.
ca@2177
  1189
            widgets at:cls put:(ctr + 1).
ca@2177
  1190
            total := total + 1.
ca@2177
  1191
        ].
ca@2177
  1192
    ].
ca@2177
  1193
    total == 0 ifTrue:[^ nil].
ca@2177
  1194
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
  1195
ca@2177
  1196
    widgets keysAndValuesDo:[:cls :ctr|
ca@2177
  1197
        list add:(MenuDesc title:(cls name)
ca@2177
  1198
                           value:(ctr printString)
ca@2177
  1199
                          action:[self doSelectNextOfClass:cls startingIn:item]
ca@2177
  1200
                 ).
ca@2177
  1201
    ].
ca@2177
  1202
    list := list asOrderedCollection.
ca@2177
  1203
    list add:(MenuDesc separator).
ca@2177
  1204
    list add:(MenuDesc title:'Total' value:(total printString)).
ca@2177
  1205
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
  1206
    menu do:[:el|
ca@2177
  1207
        el hideMenuOnActivated:false
ca@2177
  1208
    ].
ca@2177
  1209
    ^ menu
ca@2177
  1210
!
ca@2177
  1211
ca@2177
  1212
submenuGeometry:aMenu
ca@2455
  1213
    "builds and returns the geometry submenu"
ca@2455
  1214
ca@2177
  1215
    |view point inst list x y|
ca@2177
  1216
ca@2177
  1217
    view := self selectedView.
ca@2177
  1218
    view isNil ifTrue:[^ nil].
ca@2177
  1219
ca@2177
  1220
    list := OrderedCollection new.
ca@2177
  1221
ca@2177
  1222
    "/ origin
ca@2177
  1223
    point := view relativeOrigin.
ca@2177
  1224
    point isNil ifTrue:[ point := view origin ].
ca@2177
  1225
ca@2177
  1226
    x := view left.
ca@2177
  1227
    y := view top.
ca@2177
  1228
ca@2177
  1229
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1230
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1231
ca@2177
  1232
    list add:(MenuDesc title:'origin' value:inst).
ca@2177
  1233
ca@2177
  1234
    "/ corner
ca@2177
  1235
    point := view relativeCorner.
ca@2177
  1236
    point isNil ifTrue:[ point := view corner ].
ca@2177
  1237
ca@2177
  1238
    x := view right.
ca@2177
  1239
    y := view bottom.
ca@2177
  1240
ca@2177
  1241
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1242
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1243
ca@2177
  1244
    list add:(MenuDesc title:'corner' value:inst).
ca@2177
  1245
ca@2177
  1246
    "/ extent
ca@2177
  1247
    (point := view relativeExtent) isNil ifTrue:[point := view extent].
ca@2177
  1248
    list add:(MenuDesc title:'extent' value:point).
ca@2177
  1249
ca@2177
  1250
    "/ preferred extent
ca@2177
  1251
    list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
ca@2177
  1252
    list add:(MenuDesc separator).
ca@2177
  1253
ca@2177
  1254
    "/ view insets
ca@2177
  1255
    inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
ca@2177
  1256
                                         with:(view rightInset)
ca@2177
  1257
                                         with:(view topInset)
ca@2177
  1258
                                         with:(view bottomInset).
ca@2177
  1259
ca@2177
  1260
    list add:(MenuDesc title:'insets'      value:inst).
ca@2177
  1261
    list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
ca@2177
  1262
    list add:(MenuDesc title:'level'       value:(view level)).
ca@2177
  1263
    list add:(MenuDesc separator).
ca@2177
  1264
ca@2177
  1265
    (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1266
    list add:(MenuDesc title:'layout' value:inst).
ca@2177
  1267
ca@2177
  1268
    (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1269
    list add:(MenuDesc title:'transformation' value:inst).
ca@2177
  1270
ca@2177
  1271
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1272
!
ca@2177
  1273
ca@2177
  1274
submenuInspector:aMenu
ca@2455
  1275
    "builds and returns the inspector submenu"
ca@2455
  1276
ca@2177
  1277
    |view list n names label value|
ca@2177
  1278
ca@2177
  1279
    view := self selectedView.
ca@2177
  1280
    view isNil ifTrue:[^ nil].
ca@2177
  1281
ca@2177
  1282
    n := view class instSize.
ca@2177
  1283
    n > 0 ifFalse:[^ nil ].
ca@2177
  1284
ca@2177
  1285
    list  := OrderedCollection new:n.
ca@2177
  1286
    names := view class allInstVarNames.
ca@2177
  1287
ca@2177
  1288
    1 to:n do:[:i| |action|
ca@2177
  1289
        label := (names at:i) printString.
ca@2177
  1290
        value := view instVarAt:i.
ca@2177
  1291
        value isNil ifTrue:[
ca@2177
  1292
            value  := '------'.
ca@2177
  1293
            action := nil.
ca@2177
  1294
        ] ifFalse:[
ca@2177
  1295
            value  := value displayString contractAtEndTo:40.
ca@2177
  1296
            action := [(view instVarAt:i) inspect].
ca@2177
  1297
        ].
ca@2177
  1298
        list add:(MenuDesc title:label value:value action:action).
ca@2177
  1299
    ].
ca@2177
  1300
ca@2177
  1301
    ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1302
!
ca@2177
  1303
ca@2177
  1304
submenuInterface:aMenu
ca@2455
  1305
    "builds and returns the interface submenu"
ca@2455
  1306
ca@2177
  1307
    |view label inst value list|
ca@2177
  1308
ca@2177
  1309
    view := self selectedView.
ca@2177
  1310
    view isNil ifTrue:[^ nil].
ca@2177
  1311
ca@2177
  1312
    list := OrderedCollection new.
ca@2177
  1313
ca@2177
  1314
    inst  := view controller.
ca@2177
  1315
    value := nil.
ca@2177
  1316
ca@2177
  1317
    inst isNil ifTrue:[
ca@2177
  1318
        label := nil
ca@2177
  1319
    ] ifFalse:[
cg@2758
  1320
        inst == view ifTrue:[ 
cg@2758
  1321
            label := '== view itself' 
cg@2758
  1322
        ] ifFalse:[ 
cg@2758
  1323
            label := inst displayString.
cg@2758
  1324
            value := [view controller inspect].
cg@2758
  1325
        ].
ca@2177
  1326
    ].
ca@2177
  1327
    list add:(MenuDesc title:'controller' value:label action:value).
ca@2177
  1328
ca@2177
  1329
    inst := view delegate.
ca@2177
  1330
    inst notNil ifTrue:[
ca@2177
  1331
        list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
ca@2177
  1332
    ].
ca@2177
  1333
ca@2177
  1334
    inst := view application.
ca@2177
  1335
cg@2758
  1336
    inst notNil ifTrue:[ 
cg@2758
  1337
        |topAppl|
cg@2758
  1338
ca@2177
  1339
        list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
ca@2177
  1340
ca@2177
  1341
        topAppl := inst topApplication.
ca@2177
  1342
ca@2177
  1343
        (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
ca@2177
  1344
            list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
ca@2177
  1345
        ].
ca@2177
  1346
    ].
ca@2177
  1347
    list add:(MenuDesc separator).
ca@2177
  1348
ca@2177
  1349
    (view respondsTo:#'model:') ifTrue:[
ca@2177
  1350
        inst := model.
ca@2177
  1351
ca@2177
  1352
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1353
                  ifFalse:[ label := inst displayString.
ca@2177
  1354
                            value := [ view model inspect ].
ca@2177
  1355
                          ].
ca@2177
  1356
ca@2177
  1357
        list add:(MenuDesc title:'model' value:label action:value).
ca@2177
  1358
ca@2177
  1359
        (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
ca@2177
  1360
            view modelInterface keysAndValuesDo:[:key : val|
ca@2177
  1361
                val isNil ifTrue:[ label := nil ]
ca@2177
  1362
                         ifFalse:[ label := val displayString ].
ca@2177
  1363
ca@2177
  1364
                list add:(MenuDesc title:('      - ', key) value:label ).
ca@2177
  1365
            ]
ca@2177
  1366
        ].
ca@2177
  1367
    ].
ca@2177
  1368
ca@2177
  1369
    (view respondsTo:#enableChannel) ifTrue:[
ca@2177
  1370
        inst := view enableChannel.
ca@2177
  1371
ca@2177
  1372
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1373
                  ifFalse:[ label := inst displayString.
ca@2177
  1374
                            value := [ view enableChannel inspect ].
ca@2177
  1375
                          ].
ca@2177
  1376
ca@2177
  1377
        list add:(MenuDesc title:'enableChannel' value:label action:value).
ca@2177
  1378
    ].
ca@2177
  1379
ca@2177
  1380
    list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
ca@2177
  1381
ca@2177
  1382
    (view respondsTo:#listHolder) ifTrue:[
ca@2177
  1383
        inst := view listHolder.
ca@2177
  1384
ca@2177
  1385
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1386
                  ifFalse:[ label := inst class printString.
ca@2177
  1387
                            value := [ view listHolder inspect ].
ca@2177
  1388
                          ].
ca@2177
  1389
        list add:(MenuDesc title:'listHolder' value:label action:value).
ca@2177
  1390
    ].
ca@2177
  1391
ca@2177
  1392
    (view respondsTo:#list) ifTrue:[
ca@2177
  1393
        inst := view list.
ca@2177
  1394
ca@2177
  1395
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1396
                  ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
ca@2177
  1397
                            value := [ view list inspect ].
ca@2177
  1398
                          ].
ca@2177
  1399
ca@2177
  1400
        list add:(MenuDesc title:'list' value:label action:value).
ca@2177
  1401
    ].
ca@2177
  1402
ca@2177
  1403
    list last isSeparator ifTrue:[ list removeLast ].
ca@2177
  1404
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1405
!
ca@2177
  1406
ca@2177
  1407
submenuVisibility:aMenu
ca@2455
  1408
    "builds and returns the geometry submenu"
ca@2455
  1409
ca@2177
  1410
    |view list value|
ca@2177
  1411
ca@2177
  1412
    view := self selectedView.
ca@2177
  1413
    view isNil ifTrue:[^ nil].
ca@2177
  1414
ca@2177
  1415
    list := OrderedCollection new.
ca@2177
  1416
ca@2177
  1417
    list add:(MenuDesc title:'device'     value:(view device printString)).
ca@2177
  1418
    list add:(MenuDesc title:'drawableId' value:(view id)).
ca@2177
  1419
    list add:(MenuDesc title:'gcId'       value:(view gcId)).
ca@2177
  1420
ca@2177
  1421
    list add:(MenuDesc separator).
ca@2177
  1422
ca@2177
  1423
    list add:(MenuDesc title:'shown'    value:(view shown)).
ca@2177
  1424
    list add:(MenuDesc title:'realized' value:(view realized)).
ca@2177
  1425
ca@2177
  1426
    list add:(MenuDesc separator).
ca@2177
  1427
ca@2177
  1428
    list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
ca@2177
  1429
ca@2177
  1430
    (value := view visibilityChannel) isNil ifTrue:[
ca@2177
  1431
        list add:(MenuDesc title:'visibilityChannel' value:'------').
ca@2177
  1432
    ] ifFalse:[
ca@2177
  1433
        list add:(MenuDesc title:'visibilityChannel'
ca@2177
  1434
                           value:(value displayString)
ca@2177
  1435
                          action:[view visibilityChannel inspect]).
ca@2177
  1436
    ].
ca@2177
  1437
cg@2758
  1438
    ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1439
! !
ca@2177
  1440
cg@2744
  1441
!ViewTreeInspectorApplication methodsFor:'private'!
ca@2177
  1442
ca@2177
  1443
selectFocusView
cg@2762
  1444
    |rootView focusView|
ca@2177
  1445
ca@2177
  1446
    rootView := model rootView.
ca@2177
  1447
ca@2177
  1448
    (rootView notNil and:[rootView shown]) ifTrue:[
ca@2177
  1449
        focusView := rootView windowGroup focusView.
ca@2177
  1450
    ].
ca@2177
  1451
    focusView isNil ifTrue:[^ self ].
ca@2177
  1452
cg@2762
  1453
    self selectView:focusView
cg@2762
  1454
!
cg@2762
  1455
cg@2762
  1456
selectView:aView
cg@2762
  1457
    |currentItem viewItem|
cg@2762
  1458
cg@2762
  1459
    currentItem := model selectedItem.
cg@2762
  1460
cg@2762
  1461
    (currentItem notNil and:[currentItem widget == aView]) ifTrue:[
ca@2177
  1462
        ^ self
ca@2177
  1463
    ].
cg@2762
  1464
    viewItem := model listOfItems recursiveDetect:[:el| el widget == aView ].
cg@2762
  1465
cg@2762
  1466
    viewItem notNil ifTrue:[
cg@2762
  1467
        model selectItem:viewItem.
ca@2177
  1468
    ].        
ca@2177
  1469
!
ca@2177
  1470
ca@2177
  1471
setRootItem:aRootItemOrNil
ca@2177
  1472
    |theProcess|
ca@2177
  1473
ca@2177
  1474
    aRootItemOrNil isNil ifTrue:[
ca@2177
  1475
        process := nil.
ca@2177
  1476
    ] ifFalse:[
ca@2177
  1477
        "/ expand tree to level 3
ca@2177
  1478
        aRootItemOrNil do:[:aRootChild|
ca@2177
  1479
            aRootChild do:[:aSubChild| aSubChild expand ].
ca@2177
  1480
            aRootChild expand.
ca@2177
  1481
        ].
ca@2177
  1482
        aRootItemOrNil expand.
ca@2177
  1483
ca@2177
  1484
        process isNil ifTrue:[
ca@2177
  1485
            theProcess := process :=
ca@2455
  1486
                Process for:[   |update testModeChannel|
ca@2177
  1487
ca@2177
  1488
                                update := false.
ca@2455
  1489
                                testModeChannel := model testModeChannel.
ca@2177
  1490
ca@2455
  1491
                                [process == theProcess] whileTrue:[
ca@2177
  1492
                                    Delay waitForSeconds:0.5.
ca@2177
  1493
ca@2177
  1494
                                    (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
ca@2455
  1495
                                        (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
ca@2177
  1496
                                            self selectFocusView.
ca@2177
  1497
                                        ].
ca@2177
  1498
                                        update ifTrue:[
ca@2177
  1499
                                            self updateShownStatus.
ca@2177
  1500
                                        ].
ca@2177
  1501
                                        update := update not.
ca@2177
  1502
                                    ].
ca@2177
  1503
                                ].
ca@2177
  1504
ca@2177
  1505
                             ] priority:8.
cg@2744
  1506
            theProcess name:'ViewTreeInspector - Follow Focus'.
ca@2177
  1507
            theProcess resume.
ca@2177
  1508
        ].
ca@2177
  1509
    ].
ca@2177
  1510
    model rootItem:aRootItemOrNil.
ca@2177
  1511
!
ca@2177
  1512
ca@2177
  1513
updateShownStatus
ca@2177
  1514
    |rootItem min max visState listIdx visY0 visY1 height damage|
ca@2177
  1515
ca@2177
  1516
    rootItem := model rootItem.
ca@2177
  1517
    (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
ca@2177
  1518
ca@2177
  1519
    max := 0.
ca@2177
  1520
    min := 9999999.
ca@2177
  1521
ca@2177
  1522
    rootItem recursiveEachVisibleItemDo:[:anItem|
ca@2177
  1523
        visState := (anItem widget shown).
ca@2177
  1524
ca@2177
  1525
        visState ~~ anItem isDrawnShown ifTrue:[
ca@2177
  1526
            anItem isDrawnShown:visState.
ca@2177
  1527
            listIdx := treeView identityIndexOf:anItem.
ca@2177
  1528
ca@2177
  1529
            listIdx > 0 ifTrue:[    
ca@2177
  1530
                max := max max:listIdx.
ca@2177
  1531
                min := min min:listIdx.
ca@2177
  1532
            ].
ca@2177
  1533
        ].
ca@2177
  1534
    ].
ca@2177
  1535
    max < min ifTrue:[^ self].
ca@2177
  1536
    max := max + 1.
ca@2177
  1537
ca@2177
  1538
    visY0  := (treeView yVisibleOfLine:min) max:0.
ca@2177
  1539
    visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
ca@2177
  1540
    height := visY1 - visY0.
ca@2177
  1541
    
ca@2177
  1542
    height > 2 ifTrue:[
ca@2177
  1543
        treeView shown ifTrue:[
ca@2177
  1544
            damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
ca@2177
  1545
            treeView invalidateDeviceRectangle:damage repairNow:false.
ca@2177
  1546
        ].
ca@2177
  1547
    ].
ca@2177
  1548
! !
ca@2177
  1549
cg@2744
  1550
!ViewTreeInspectorApplication methodsFor:'selection'!
ca@2177
  1551
ca@2177
  1552
selectedView
ca@2455
  1553
    "answer the selected view or nil"
ca@2455
  1554
ca@2177
  1555
    |item|
ca@2177
  1556
ca@2177
  1557
    item := model selectedItem.
ca@2177
  1558
    item notNil ifTrue:[ ^ item widget ].
ca@2177
  1559
  ^ nil
ca@2177
  1560
! !
ca@2177
  1561
cg@2744
  1562
!ViewTreeInspectorApplication methodsFor:'testing'!
ca@2177
  1563
ca@2177
  1564
resolveApplicationClassFor:aTreeItem
ca@2177
  1565
    aTreeItem isApplicationClass ifTrue:[
ca@2177
  1566
       ^ aTreeItem applicationClass
ca@2177
  1567
    ].
ca@2177
  1568
    ^ nil
ca@2177
  1569
!
ca@2177
  1570
ca@2177
  1571
selectedComponentHasChildren
ca@2177
  1572
    |item|
ca@2177
  1573
ca@2177
  1574
    item := model selectedItem.
ca@2177
  1575
    ^ (item notNil and:[item hasChildren])
ca@2177
  1576
! !
ca@2177
  1577
cg@2744
  1578
!ViewTreeInspectorApplication methodsFor:'user operations'!
ca@2177
  1579
ca@2177
  1580
doBrowse:what
ca@2177
  1581
    "open browser on:
ca@2177
  1582
        #view           browse class
ca@2177
  1583
        #model          browse model class
ca@2177
  1584
        #application    browse application class
ca@2177
  1585
        #controller     browse controller class
ca@2177
  1586
    "
ca@2177
  1587
    |view inst|
ca@2177
  1588
ca@2177
  1589
    view := self selectedView.
ca@2177
  1590
    view isNil ifTrue:[^ self].
ca@2177
  1591
ca@2177
  1592
             what == #view        ifTrue:[ inst := view ]
ca@2177
  1593
    ifFalse:[what == #model       ifTrue:[ inst := view model ]
ca@2177
  1594
    ifFalse:[what == #application ifTrue:[ inst := view application ]
ca@2177
  1595
    ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
ca@2177
  1596
    ifFalse:[
ca@2177
  1597
        ^ self
ca@2177
  1598
    ]]]].
ca@2177
  1599
ca@2177
  1600
    inst notNil ifTrue:[
ca@2177
  1601
        inst class browserClass openInClass:(inst class) selector:nil
ca@2177
  1602
    ].
ca@2177
  1603
!
ca@2177
  1604
ca@2177
  1605
doDestroy
ca@2455
  1606
    "destroy the current selected view"
ca@2455
  1607
ca@2177
  1608
    |item parent|
ca@2177
  1609
ca@2177
  1610
    item := model selectedItem.
ca@2177
  1611
    item isNil ifTrue:[ ^ self].
ca@2177
  1612
ca@2177
  1613
    parent := item parent.
ca@2177
  1614
ca@2177
  1615
    parent isNil ifTrue:[
ca@2177
  1616
        "/ the root
ca@2177
  1617
        model withSelectionHiddenDo:[item deleteAll].
ca@2177
  1618
      ^ self
ca@2177
  1619
    ].
ca@2177
  1620
ca@2177
  1621
    model withSelectionHiddenDo:[
ca@2177
  1622
        |idx nsel|
ca@2177
  1623
ca@2177
  1624
        idx := parent identityIndexOf:item.
ca@2177
  1625
ca@2177
  1626
        idx == parent size ifTrue:[
ca@2177
  1627
            nsel := parent at:(idx - 1) ifAbsent:parent
ca@2177
  1628
        ] ifFalse:[
ca@2177
  1629
            nsel := parent at:(idx + 1)
ca@2177
  1630
        ].
ca@2177
  1631
        model setValue:nil.
ca@2177
  1632
        item delete.
ca@2177
  1633
ca@2177
  1634
        parent isLayoutContainer ifTrue:[
ca@2177
  1635
            parent widget sizeChanged:nil
ca@2177
  1636
        ].
ca@2177
  1637
        model value:nsel.
ca@2177
  1638
    ].
ca@2177
  1639
!
ca@2177
  1640
ca@2177
  1641
doFlash
ca@2455
  1642
    "flash the selected view"
ca@2455
  1643
ca@2177
  1644
    |view|
ca@2177
  1645
ca@2177
  1646
    view := self selectedView.
ca@2177
  1647
    view isNil ifTrue:[ ^ self].
ca@2177
  1648
ca@2177
  1649
    view shown ifTrue:[
ca@2177
  1650
        model withSelectionHiddenDo:[
ca@2177
  1651
            view perform:#flash ifNotUnderstood:nil.
ca@2177
  1652
        ].
ca@2177
  1653
    ].
ca@2177
  1654
!
ca@2177
  1655
ca@2177
  1656
doInspect:what
ca@2177
  1657
    "open inspector on:
ca@2177
  1658
        #view           inspect class
ca@2177
  1659
        #group          inspect windowGroup
ca@2177
  1660
        #model          inspect model
ca@2177
  1661
        #application    inspect application
ca@2177
  1662
        #controller     inspect controller
ca@2177
  1663
    "
ca@2177
  1664
    |inst|
ca@2177
  1665
ca@2177
  1666
    inst := self selectedView.
ca@2177
  1667
    inst isNil ifTrue:[^ self].
ca@2177
  1668
ca@2177
  1669
             what == #group       ifTrue:[ inst := inst windowGroup ]
ca@2177
  1670
    ifFalse:[what == #model       ifTrue:[ inst := inst model ]
ca@2177
  1671
    ifFalse:[what == #application ifTrue:[ inst := inst application ]
ca@2177
  1672
    ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
ca@2177
  1673
ca@2177
  1674
    inst notNil ifTrue:[ inst inspect ].
ca@2177
  1675
!
ca@2177
  1676
cg@2762
  1677
doPickView
ca@2455
  1678
    "pick a window's topView"
ca@2455
  1679
cg@2762
  1680
    |screen clickedView topWindow cursor|
ca@2177
  1681
ca@2177
  1682
    self doUnpick.
ca@2177
  1683
cg@2759
  1684
    cursor := Cursor fromImage:(self class crossHairIcon).
cg@2759
  1685
cg@2759
  1686
    screen := Screen current.
cg@2762
  1687
    clickedView := screen viewFromPoint:(screen pointFromUserShowing:cursor).
cg@2762
  1688
    clickedView isNil ifTrue:[^ self].
cg@2762
  1689
cg@2762
  1690
    topWindow := clickedView topView.
cg@2762
  1691
cg@2762
  1692
    (    topWindow == Screen current rootView
cg@2762
  1693
     or:[topWindow == self window topView]
ca@2177
  1694
    ) ifTrue:[
ca@2177
  1695
        ^ self
ca@2177
  1696
    ].
cg@2762
  1697
    self setRootItem:(ViewTreeItem buildViewsFrom:topWindow).
cg@2762
  1698
    self selectView:clickedView.
ca@2177
  1699
!
ca@2177
  1700
ca@2177
  1701
doSelectNextOfApplicationClass:aClass startingIn:anItem
ca@2177
  1702
    |startItem firstFound searchNext|
ca@2177
  1703
ca@2177
  1704
    startItem  := model last.
ca@2177
  1705
    searchNext := startItem notNil.        
ca@2177
  1706
    firstFound := nil.
ca@2177
  1707
ca@2177
  1708
    anItem recursiveDo:[:el|
ca@2177
  1709
        el == startItem ifTrue:[
ca@2177
  1710
            searchNext := false
ca@2177
  1711
        ] ifFalse:[
ca@2177
  1712
            (self resolveApplicationClassFor:el) == aClass ifTrue:[
ca@2177
  1713
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1714
ca@2177
  1715
                firstFound isNil ifTrue:[
ca@2177
  1716
                    firstFound := el
ca@2177
  1717
                ]
ca@2177
  1718
            ]
ca@2177
  1719
        ]
ca@2177
  1720
    ].
ca@2177
  1721
    firstFound notNil ifTrue:[
ca@2177
  1722
        self window beep.
ca@2177
  1723
        model selectItem:firstFound
ca@2177
  1724
    ].
ca@2177
  1725
!
ca@2177
  1726
ca@2177
  1727
doSelectNextOfClass:aClass startingIn:anItem
ca@2177
  1728
    |startItem firstFound searchNext|
ca@2177
  1729
ca@2177
  1730
    startItem  := model last.
ca@2177
  1731
    searchNext := startItem notNil.        
ca@2177
  1732
    firstFound := nil.
ca@2177
  1733
ca@2177
  1734
    anItem recursiveDo:[:el|
ca@2177
  1735
        el == startItem ifTrue:[
ca@2177
  1736
            searchNext := false
ca@2177
  1737
        ] ifFalse:[
ca@2177
  1738
            el widget class == aClass ifTrue:[
ca@2177
  1739
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1740
ca@2177
  1741
                firstFound isNil ifTrue:[
ca@2177
  1742
                    firstFound := el
ca@2177
  1743
                ]
ca@2177
  1744
            ]
ca@2177
  1745
        ]
ca@2177
  1746
    ].
ca@2177
  1747
    firstFound notNil ifTrue:[
ca@2177
  1748
        self window beep.
ca@2177
  1749
        model selectItem:firstFound
ca@2177
  1750
    ].
ca@2177
  1751
!
ca@2177
  1752
ca@2177
  1753
doUnpick
ca@2455
  1754
    "release current picked window and contained subwindows"
ca@2455
  1755
ca@2177
  1756
    self setRootItem:nil.
cg@2744
  1757
!
cg@2744
  1758
cg@2744
  1759
openDocumentation
cg@2744
  1760
    HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
ca@2177
  1761
! !
ca@2177
  1762
cg@2744
  1763
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
ca@2177
  1764
ca@2177
  1765
buildFromList:aList onGC:aMenu
ca@2177
  1766
    |tabSpec menu w menuPanel|
ca@2177
  1767
ca@2177
  1768
    w := 0.
ca@2177
  1769
    aList do:[:el| w := w max:(el widthOn:aMenu) ].
ca@2177
  1770
ca@2177
  1771
    tabSpec := TabulatorSpecification new.
ca@2177
  1772
    tabSpec unit:#pixel.
ca@2177
  1773
    tabSpec positions:#(0     1.5 ).
ca@2177
  1774
    tabSpec align:#(#left #left).
ca@2177
  1775
ca@2177
  1776
    w := w + 15.
ca@2177
  1777
    tabSpec positions:(Array with:0 with:w).
ca@2177
  1778
ca@2177
  1779
    menu := Menu new.
ca@2177
  1780
ca@2177
  1781
    aList do:[:el|
ca@2177
  1782
        menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
ca@2177
  1783
    ].
ca@2177
  1784
    menuPanel := MenuPanel menu:menu.
ca@2177
  1785
    ^ menuPanel
ca@2177
  1786
! !
ca@2177
  1787
cg@2744
  1788
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
ca@2177
  1789
ca@2177
  1790
separator
ca@2177
  1791
    ^ self new
ca@2177
  1792
!
ca@2177
  1793
ca@2177
  1794
title:aTitle value:aValue
ca@2177
  1795
    ^ self title:aTitle value:aValue action:nil
ca@2177
  1796
!
ca@2177
  1797
ca@2177
  1798
title:aTitle value:aValue action:anAction
ca@2177
  1799
    ^ self new title:aTitle value:aValue action:anAction
ca@2177
  1800
! !
ca@2177
  1801
cg@2744
  1802
!ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
ca@2177
  1803
ca@2177
  1804
title
ca@2177
  1805
    ^ title
ca@2177
  1806
! !
ca@2177
  1807
cg@2744
  1808
!ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
ca@2177
  1809
ca@2177
  1810
asMenuItemWithTabulatorSpecification:aTabSpec
ca@2177
  1811
    |array|
ca@2177
  1812
ca@2177
  1813
    title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
ca@2177
  1814
ca@2177
  1815
    array := Array with:(title, ':') with:'------'.
ca@2177
  1816
ca@2177
  1817
    value notNil ifTrue:[
ca@2177
  1818
        array at:2 put:(value printString, ' ')
ca@2177
  1819
    ].
ca@2177
  1820
cg@2758
  1821
   ^ MenuItem 
cg@2758
  1822
        label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
cg@2758
  1823
        value:action
ca@2177
  1824
! !
ca@2177
  1825
cg@2744
  1826
!ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
ca@2177
  1827
ca@2177
  1828
title:aTitle value:aValue action:anAction
ca@2177
  1829
    "test for separator
ca@2177
  1830
    "
ca@2177
  1831
    title  := aTitle withoutSeparators.
ca@2177
  1832
    action := anAction.
ca@2177
  1833
ca@2177
  1834
    aValue notNil ifTrue:[
ca@2177
  1835
        value := aValue printString.
ca@2177
  1836
ca@2177
  1837
        value size > 70 ifTrue:[
ca@2177
  1838
            value := value copyFrom:1 to:70.
ca@2177
  1839
            value := value, '...'
ca@2177
  1840
        ]
ca@2177
  1841
    ].
ca@2177
  1842
! !
ca@2177
  1843
cg@2744
  1844
!ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
ca@2177
  1845
ca@2177
  1846
isSeparator
ca@2177
  1847
    ^ title isNil
ca@2177
  1848
!
ca@2177
  1849
ca@2177
  1850
widthOn:aGC
ca@2177
  1851
    title isNil ifTrue:[^ 5].  "/ separator
cg@2758
  1852
    ^ title widthOn:aGC
ca@2177
  1853
! !
ca@2177
  1854
cg@2744
  1855
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
cg@2744
  1856
cg@2744
  1857
buildViewsFrom:aView
cg@2744
  1858
    "build the items starting from a source view;
cg@2744
  1859
     returns the anhor.
cg@2744
  1860
    "
cg@2744
  1861
    |item subViews subItems|
cg@2744
  1862
cg@2744
  1863
    aView isNil ifTrue:[^ nil].
cg@2744
  1864
cg@2744
  1865
    item     := self forView:aView.
cg@2744
  1866
    subViews := aView subViews.
cg@2744
  1867
cg@2744
  1868
    subViews notEmptyOrNil ifTrue:[
cg@2744
  1869
        subItems := OrderedCollection new.
cg@2744
  1870
        subViews do:[:aSubView|
cg@2744
  1871
            subItems add:(self buildViewsFrom:aSubView).
cg@2744
  1872
        ].
cg@2744
  1873
        item children:subItems.
cg@2744
  1874
    ].
cg@2744
  1875
    ^ item
cg@2744
  1876
! !
cg@2744
  1877
cg@2744
  1878
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
cg@2744
  1879
cg@2744
  1880
documentation
cg@2744
  1881
"
cg@2744
  1882
    ViewTreeItems represants a pickable object within a ViewTreeModel.
cg@2744
  1883
    The class is used to build up the hierarchical tree.
cg@2744
  1884
cg@2744
  1885
    [Instance variables:]
cg@2744
  1886
        widget        <View>            the widget represented by the item
cg@2744
  1887
        spec          <UISpecification> the UISpecification or nil
cg@2744
  1888
cg@2744
  1889
    [Class variables:]
cg@2744
  1890
        HandleExtent  <Point>           keeps the extent of a handle
cg@2744
  1891
cg@2744
  1892
cg@2744
  1893
    [author:]
cg@2744
  1894
        Claus Atzkern
cg@2744
  1895
cg@2744
  1896
    [see also:]
cg@2744
  1897
        HierarchicalItem
cg@2744
  1898
        ViewTreeModel
cg@2744
  1899
"
cg@2744
  1900
!
ca@2177
  1901
ca@2177
  1902
version
ca@2177
  1903
    ^ '$Header$'
ca@2177
  1904
! !
ca@2177
  1905
cg@2744
  1906
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
cg@2744
  1907
cg@2744
  1908
initialize
cg@2744
  1909
    "set the extent of the Handle
cg@2744
  1910
    "
cg@2744
  1911
    HandleExtent := 6@6.
cg@2744
  1912
! !
cg@2744
  1913
cg@2744
  1914
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
cg@2744
  1915
cg@2744
  1916
forView:aView
cg@2744
  1917
    |item|
cg@2744
  1918
cg@2744
  1919
    item := self basicNew initialize.
cg@2744
  1920
    item forView:aView.
cg@2744
  1921
  ^ item
cg@2744
  1922
!
cg@2744
  1923
cg@2744
  1924
new
cg@2744
  1925
    self error:'not allowed'.
cg@2744
  1926
  ^ nil
cg@2744
  1927
!
cg@2744
  1928
cg@2744
  1929
on:aView withSpec:aSpec
cg@2744
  1930
    |item|
cg@2744
  1931
cg@2744
  1932
    item := self basicNew initialize.
cg@2744
  1933
    item on:aView withSpec:aSpec.
cg@2744
  1934
  ^ item
cg@2744
  1935
! !
cg@2744
  1936
cg@2744
  1937
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
cg@2744
  1938
cg@2744
  1939
applicationClass
cg@2744
  1940
    |appl|
cg@2744
  1941
cg@2744
  1942
    widget notNil ifTrue:[
cg@2744
  1943
        appl := widget application.
cg@2744
  1944
        appl notNil ifTrue:[^ appl class ].
cg@2744
  1945
    ].
cg@2744
  1946
    ^ nil
cg@2744
  1947
!
cg@2744
  1948
cg@2744
  1949
isDrawnShown
cg@2744
  1950
    "returns true if the last display operations was done during the widget was shown
cg@2744
  1951
    "
cg@2744
  1952
    ^ isDrawnShown
cg@2744
  1953
!
cg@2744
  1954
cg@2744
  1955
isDrawnShown:aBoolean
cg@2744
  1956
    isDrawnShown := aBoolean.
cg@2744
  1957
!
cg@2744
  1958
cg@2744
  1959
rootView
cg@2744
  1960
    "returns the widget assigned to the root or nil
cg@2744
  1961
    "
cg@2744
  1962
    ^ parent rootView
cg@2744
  1963
!
cg@2744
  1964
cg@2744
  1965
specClass
cg@2744
  1966
    "returns the spec-class assigned to the item
cg@2744
  1967
    "
cg@2744
  1968
    ^ widget specClass
cg@2744
  1969
!
cg@2744
  1970
cg@2744
  1971
treeModel
cg@2744
  1972
    "returns the assigned treeModel, an instance of ViewTreeModel
cg@2744
  1973
    "
cg@2744
  1974
    ^ parent treeModel
cg@2744
  1975
!
cg@2744
  1976
cg@2744
  1977
widget
cg@2744
  1978
    "returns the widget assigned to the item
cg@2744
  1979
    "
cg@2744
  1980
    ^ widget
cg@2744
  1981
! !
cg@2744
  1982
cg@2744
  1983
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
cg@2744
  1984
cg@2744
  1985
boundsRelativeToRoot
cg@2744
  1986
    "returns the bounds relative to the root widget
cg@2744
  1987
    "
cg@2744
  1988
    ^ self originRelativeToRoot extent:(widget extent)
cg@2744
  1989
!
cg@2744
  1990
cg@2744
  1991
cornerRelativeToRoot
cg@2744
  1992
    "returns the corner relative to the root widget
cg@2744
  1993
    "
cg@2744
  1994
    ^ self originRelativeToRoot + (widget extent)
cg@2744
  1995
!
cg@2744
  1996
cg@2744
  1997
extent
cg@2744
  1998
    "returns the extent of the widget
cg@2744
  1999
    "
cg@2744
  2000
    ^ widget extent
cg@2744
  2001
!
cg@2744
  2002
cg@2744
  2003
layoutType
cg@2744
  2004
    "returns the type of layout assigned to the wiget; nil if the
cg@2744
  2005
     superView cannot resize its sub widgets
cg@2744
  2006
    "
cg@2744
  2007
    |layout specClass superView|
cg@2744
  2008
cg@2744
  2009
    (superView := widget superView) isNil ifTrue:[
cg@2744
  2010
        ^ #Extent
cg@2744
  2011
    ].
cg@2744
  2012
        
cg@2744
  2013
    specClass := superView specClass.
cg@2744
  2014
cg@2744
  2015
    (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
cg@2744
  2016
        ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
cg@2744
  2017
    ].
cg@2744
  2018
cg@2744
  2019
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  2020
        ^ #Extent
cg@2744
  2021
    ].
cg@2744
  2022
cg@2744
  2023
    layout isLayout ifTrue:[
cg@2744
  2024
        layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
cg@2744
  2025
        layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
cg@2744
  2026
        layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
cg@2744
  2027
    ] ifFalse:[
cg@2744
  2028
        layout isRectangle          ifTrue:[ ^ #Rectangle ].
cg@2744
  2029
        layout isPoint              ifTrue:[ ^ #Point ].
cg@2744
  2030
cg@2744
  2031
    ].
cg@2744
  2032
    Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
cg@2744
  2033
  ^ nil
cg@2744
  2034
!
cg@2744
  2035
cg@2744
  2036
originRelativeToRoot
cg@2744
  2037
    "returns the origin relative to the root widget
cg@2744
  2038
    "
cg@2744
  2039
    ^ widget originRelativeTo:(self rootView)
cg@2744
  2040
! !
cg@2744
  2041
cg@2744
  2042
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
cg@2744
  2043
cg@2744
  2044
children
cg@2744
  2045
    "redefined: optimize
cg@2744
  2046
    "
cg@2744
  2047
    ^ children
cg@2744
  2048
!
cg@2744
  2049
cg@2744
  2050
hasChildren
cg@2744
  2051
    |subViews list item|
cg@2744
  2052
cg@2744
  2053
    children size ~~ 0 ifTrue:[
cg@2744
  2054
        ^ true
cg@2744
  2055
    ].
cg@2744
  2056
    isExpanded := false.
cg@2744
  2057
    subViews   := widget subViews.
cg@2744
  2058
cg@2744
  2059
    subViews size == 0 ifTrue:[^ false].
cg@2744
  2060
cg@2744
  2061
    list := OrderedCollection new.
cg@2744
  2062
cg@2744
  2063
    subViews do:[:aSubView|
cg@2744
  2064
        item := self class buildViewsFrom:aSubView.
cg@2744
  2065
        item parent:self.
cg@2744
  2066
        list add:item.
cg@2744
  2067
    ].
cg@2744
  2068
    children := list.
cg@2744
  2069
    ^ true
cg@2744
  2070
!
cg@2744
  2071
cg@2744
  2072
size
cg@2744
  2073
    "redefined: returns list of children
cg@2744
  2074
    "
cg@2744
  2075
    ^ children size
cg@2744
  2076
! !
cg@2744
  2077
cg@2744
  2078
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
cg@2744
  2079
cg@2744
  2080
additionalLabelForItem:anItem
cg@2744
  2081
    "answer an additional item for an Item or nil"
cg@2744
  2082
cg@2744
  2083
    parent notNil ifTrue:[
cg@2744
  2084
        ^ parent additionalLabelForItem:anItem
cg@2744
  2085
    ].
cg@2744
  2086
    ^ nil
cg@2744
  2087
!
cg@2744
  2088
cg@2744
  2089
displayIcon:anIcon atX:x y:y on:aGC
cg@2744
  2090
    |x0 y0 y1 w|
cg@2744
  2091
cg@2744
  2092
    super displayIcon:anIcon atX:x y:y on:aGC.
cg@2744
  2093
cg@2744
  2094
    self exists ifFalse:[
cg@2744
  2095
        aGC paint:(Color red).
cg@2744
  2096
cg@2744
  2097
        y0 := y + 1.
cg@2744
  2098
        y1 := y + anIcon height - 2.
cg@2744
  2099
cg@2744
  2100
        x0 := x - 1.
cg@2744
  2101
        w  := anIcon width.
cg@2744
  2102
cg@2744
  2103
        2 timesRepeat:[
cg@2744
  2104
            aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
cg@2744
  2105
            aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
cg@2744
  2106
            x0 := x0 + 1.
cg@2744
  2107
        ].
cg@2744
  2108
    ].
cg@2744
  2109
!
cg@2744
  2110
cg@2744
  2111
displayOn:aGC x:x y:y h:h
cg@2744
  2112
    |labelHeight additionalName label isValidAndShown|
cg@2744
  2113
cg@2744
  2114
    label := self label.
cg@2744
  2115
    label isEmptyOrNil ifTrue:[^ self].
cg@2744
  2116
cg@2744
  2117
    widget id isNil ifTrue:[
cg@2744
  2118
        isDrawnShown := false.
cg@2744
  2119
cg@2744
  2120
        self exists ifFalse:[
cg@2744
  2121
            xOffsetAdditionalName := nil.
cg@2744
  2122
        ].
cg@2744
  2123
        isValidAndShown := false.
cg@2744
  2124
    ] ifFalse:[
cg@2744
  2125
        isValidAndShown := widget shown.
cg@2744
  2126
    ].
cg@2744
  2127
    isValidAndShown ifFalse:[
cg@2762
  2128
        label := Text string:label emphasis:#italic.
cg@2762
  2129
        label colorizeAllWith:Color grey.
cg@2744
  2130
    ].
cg@2744
  2131
cg@2744
  2132
    labelHeight := self heightOn:aGC.
cg@2744
  2133
    self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
cg@2744
  2134
cg@2744
  2135
    xOffsetAdditionalName notNil ifTrue:[
cg@2744
  2136
        additionalName := self additionalLabelForItem:self.
cg@2744
  2137
cg@2744
  2138
        additionalName notNil ifTrue:[
cg@2744
  2139
            self displayLabel:additionalName
cg@2744
  2140
                            h:labelHeight on:aGC
cg@2744
  2141
                            x:(x + xOffsetAdditionalName)
cg@2744
  2142
                            y:y
cg@2744
  2143
                            h:h.
cg@2744
  2144
        ] ifFalse:[
cg@2744
  2145
            xOffsetAdditionalName := nil.
cg@2744
  2146
        ].
cg@2744
  2147
    ].
cg@2744
  2148
!
cg@2744
  2149
cg@2744
  2150
recursiveAdditionalNameBehaviourChanged
cg@2744
  2151
    width := xOffsetAdditionalName := nil.
cg@2744
  2152
cg@2744
  2153
    children notNil ifTrue:[
cg@2744
  2154
        children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
cg@2744
  2155
    ].
cg@2744
  2156
!
cg@2744
  2157
cg@2744
  2158
widthOn:aGC
cg@2744
  2159
    "return the width of the receiver, if it is to be displayed on aGC
cg@2744
  2160
    "
cg@2744
  2161
    |additionalName|
cg@2744
  2162
cg@2744
  2163
    width isNil ifTrue:[
cg@2744
  2164
        width := self widthOf:(self label) on:aGC.
cg@2744
  2165
        width := width + 2.
cg@2744
  2166
cg@2744
  2167
        additionalName := self additionalLabelForItem:self.
cg@2744
  2168
cg@2744
  2169
        additionalName notNil ifTrue:[
cg@2744
  2170
            xOffsetAdditionalName := width + 10.
cg@2744
  2171
            width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
cg@2744
  2172
            width := width + 2.
cg@2744
  2173
        ] ifFalse:[
cg@2744
  2174
            xOffsetAdditionalName := nil.
cg@2744
  2175
        ].
cg@2744
  2176
    ].
cg@2744
  2177
    ^ width
cg@2744
  2178
! !
cg@2744
  2179
cg@2744
  2180
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
cg@2744
  2181
cg@2744
  2182
handlesDo:aTwoArgAction
cg@2744
  2183
    "evaluate the two arg block on each handle; the arguments to the block is
cg@2744
  2184
     the rectangle relative to the rootView and the handle type which is
cg@2744
  2185
     set to nil if not resizeable.
cg@2744
  2186
cg@2744
  2187
     TYPES:     type    position( X - Y )
cg@2744
  2188
                -------------------------        
cg@2744
  2189
                #LT     Left   - Top
cg@2744
  2190
                #LC     Left   - Center
cg@2744
  2191
                #LB     Left   - Bottom
cg@2744
  2192
                #CT     Center - Top
cg@2744
  2193
                #CB     Center - Bottom
cg@2744
  2194
                #RT     Right  - Top
cg@2744
  2195
                #RC     Right  - Center
cg@2744
  2196
                #RB     Right  - Bottom
cg@2744
  2197
cg@2744
  2198
                nil     ** handle not pickable **
cg@2744
  2199
    "
cg@2744
  2200
    |type relOrg relCrn maxExt rootView w h
cg@2744
  2201
     xL    "{ Class:SmallInteger }"
cg@2744
  2202
     xC    "{ Class:SmallInteger }"
cg@2744
  2203
     xR    "{ Class:SmallInteger }"
cg@2744
  2204
     yT    "{ Class:SmallInteger }"
cg@2744
  2205
     yC    "{ Class:SmallInteger }"
cg@2744
  2206
     yB    "{ Class:SmallInteger }"
cg@2744
  2207
    |
cg@2744
  2208
    rootView := self rootView.
cg@2744
  2209
    relOrg   := widget originRelativeTo:rootView.
cg@2744
  2210
    relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
cg@2744
  2211
cg@2744
  2212
    relOrg   := relOrg - (HandleExtent // 2).
cg@2744
  2213
    relCrn   := relOrg + widget extent.
cg@2744
  2214
    maxExt   := rootView extent - HandleExtent.
cg@2744
  2215
cg@2744
  2216
    xL := relOrg x max:0.
cg@2744
  2217
    xR := relCrn x min:(maxExt x).
cg@2744
  2218
    xC := xR + xL // 2.
cg@2744
  2219
cg@2744
  2220
    yT := relOrg y max:0.
cg@2744
  2221
    yB := relCrn y min:(maxExt y).
cg@2744
  2222
    yC := yB + yT // 2.
cg@2744
  2223
cg@2744
  2224
    type := self layoutType.
cg@2744
  2225
    w   := HandleExtent x.
cg@2744
  2226
    h   := HandleExtent y.
cg@2744
  2227
cg@2744
  2228
    (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
cg@2744
  2229
        aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
cg@2744
  2230
        aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
cg@2744
  2231
        aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
cg@2744
  2232
        aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
cg@2744
  2233
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
cg@2744
  2234
        aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
cg@2744
  2235
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
cg@2744
  2236
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
cg@2744
  2237
      ^ self
cg@2744
  2238
    ].
cg@2744
  2239
cg@2744
  2240
    aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
cg@2744
  2241
    aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
cg@2744
  2242
    aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
cg@2744
  2243
cg@2744
  2244
    type == #Extent ifTrue:[
cg@2744
  2245
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
cg@2744
  2246
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
cg@2744
  2247
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
cg@2744
  2248
      ^ self
cg@2744
  2249
    ].
cg@2744
  2250
    aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
cg@2744
  2251
!
cg@2744
  2252
cg@2744
  2253
recursiveEachVisibleItemDo:anOneArgBlock
cg@2744
  2254
    "recursive evaluate the block on each child which is visible
cg@2744
  2255
    "
cg@2744
  2256
    (isExpanded and:[children size > 0]) ifTrue:[
cg@2744
  2257
        children do:[:aChild|
cg@2744
  2258
            anOneArgBlock value:aChild.
cg@2744
  2259
            aChild recursiveEachVisibleItemDo:anOneArgBlock.
cg@2744
  2260
        ]
cg@2744
  2261
    ].
cg@2744
  2262
!
cg@2744
  2263
cg@2744
  2264
subViewsDo:aOneArgBlock
cg@2744
  2265
    "evaluate aBlock for all subviews other than InputView's   
cg@2744
  2266
    "
cg@2744
  2267
    |subViews|
cg@2744
  2268
cg@2744
  2269
    subViews := widget subViews.
cg@2744
  2270
cg@2744
  2271
    subViews notNil ifTrue:[
cg@2744
  2272
        subViews do:aOneArgBlock
cg@2744
  2273
    ].
cg@2744
  2274
! !
cg@2744
  2275
cg@2744
  2276
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
cg@2744
  2277
cg@2744
  2278
forView:aView
cg@2744
  2279
    widget := aView.
cg@2744
  2280
!
cg@2744
  2281
cg@2744
  2282
initialize
cg@2744
  2283
    "setup default attributes
cg@2744
  2284
    "
cg@2744
  2285
    super initialize.
cg@2744
  2286
    isDrawnShown := false.
cg@2744
  2287
    isExpanded   := false.
cg@2744
  2288
    children     := OrderedCollection new.
cg@2744
  2289
! !
cg@2744
  2290
cg@2744
  2291
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
cg@2744
  2292
cg@2744
  2293
delete
cg@2744
  2294
    "delete self and all contained items; the assigned views are destroyed
cg@2744
  2295
     in case of rootView, only the children are deleted
cg@2744
  2296
    "
cg@2744
  2297
    parent isHierarchicalItem ifTrue:[
cg@2744
  2298
        self criticalDo:[
cg@2744
  2299
            parent remove:self.
cg@2744
  2300
            widget destroy.
cg@2744
  2301
        ]
cg@2744
  2302
    ] ifFalse:[
cg@2744
  2303
        self deleteAll
cg@2744
  2304
    ].
cg@2744
  2305
!
cg@2744
  2306
cg@2744
  2307
deleteAll
cg@2744
  2308
    "delete all contained items; the assigned views are destroyed
cg@2744
  2309
    "
cg@2744
  2310
    children size == 0 ifTrue:[^ self].
cg@2744
  2311
cg@2744
  2312
    self criticalDo:[
cg@2744
  2313
        self nonCriticalDo:[:el| el widget destroy ].
cg@2744
  2314
        self removeAll
cg@2744
  2315
    ].
cg@2744
  2316
! !
cg@2744
  2317
cg@2744
  2318
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
cg@2744
  2319
cg@2744
  2320
asLayoutFrame
cg@2744
  2321
    "convert the layout of the widget to a LayoutFrame;
cg@2744
  2322
    "
cg@2744
  2323
    |extent layout newLyt lftFrc lftOff topFrc topOff|
cg@2744
  2324
cg@2744
  2325
    layout := widget geometryLayout.
cg@2744
  2326
cg@2744
  2327
    layout isNil ifTrue:[
cg@2744
  2328
        ^ widget bounds asLayout
cg@2744
  2329
    ].
cg@2744
  2330
cg@2744
  2331
    layout isLayout ifFalse:[
cg@2744
  2332
        layout isRectangle ifTrue:[
cg@2744
  2333
            ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
cg@2744
  2334
                           topOffset:(layout top) bottomOffset:(layout bottom)
cg@2744
  2335
        ].
cg@2744
  2336
        layout isPoint ifTrue:[
cg@2744
  2337
            extent := widget extent.
cg@2744
  2338
          ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
cg@2744
  2339
                         topOffset:(layout y) bottomOffset:(layout y + extent y)
cg@2744
  2340
        ].
cg@2744
  2341
cg@2744
  2342
        Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
cg@2744
  2343
      ^ nil
cg@2744
  2344
    ].
cg@2744
  2345
cg@2744
  2346
    layout isLayoutFrame ifTrue:[ ^ layout copy ].    
cg@2744
  2347
cg@2744
  2348
    lftFrc := layout leftFraction.
cg@2744
  2349
    lftOff := layout leftOffset.
cg@2744
  2350
    topFrc := layout topFraction.
cg@2744
  2351
    topOff := layout topOffset.
cg@2744
  2352
    extent := widget extent.
cg@2744
  2353
cg@2744
  2354
    newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
cg@2744
  2355
                         rightFraction:lftFrc offset:(lftOff + extent x)
cg@2744
  2356
                           topFraction:topFrc offset:topOff
cg@2744
  2357
                        bottomFraction:topFrc offset:(topOff + extent y).
cg@2744
  2358
cg@2744
  2359
    (      layout isAlignmentOrigin
cg@2744
  2360
     and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
cg@2744
  2361
    ) ifTrue:[
cg@2744
  2362
        |svRc prBd dlta|
cg@2744
  2363
cg@2744
  2364
        svRc := widget superView viewRectangle.
cg@2744
  2365
        prBd := widget preferredBounds.
cg@2744
  2366
cg@2744
  2367
        dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
cg@2744
  2368
                 - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
cg@2744
  2369
                ) rounded.
cg@2744
  2370
cg@2744
  2371
        newLyt   leftOffset:(lftOff + dlta x).
cg@2744
  2372
        newLyt  rightOffset:(lftOff + extent x + dlta x).
cg@2744
  2373
        newLyt    topOffset:(topOff + dlta y).
cg@2744
  2374
        newLyt bottomOffset:(topOff + extent y + dlta y).
cg@2744
  2375
    ].
cg@2744
  2376
    ^ newLyt
cg@2744
  2377
!
cg@2744
  2378
cg@2744
  2379
moveLeft:l top:t
cg@2744
  2380
    "move the widget n pixele left and right
cg@2744
  2381
    "
cg@2744
  2382
    |layout|
cg@2744
  2383
cg@2744
  2384
    self isMoveable ifFalse:[ ^ self ].
cg@2744
  2385
cg@2744
  2386
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  2387
        "Extent"
cg@2744
  2388
        widget origin:(widget origin + (l@t)).
cg@2744
  2389
      ^ self
cg@2744
  2390
    ].
cg@2744
  2391
cg@2744
  2392
    layout := layout copy.
cg@2744
  2393
cg@2744
  2394
    layout isLayout ifTrue:[
cg@2744
  2395
        layout leftOffset:(layout leftOffset + l)
cg@2744
  2396
                topOffset:(layout topOffset  + t).
cg@2744
  2397
cg@2744
  2398
        layout isLayoutFrame ifTrue:[
cg@2744
  2399
            layout  rightOffset:(layout rightOffset  + l).
cg@2744
  2400
            layout bottomOffset:(layout bottomOffset + t).
cg@2744
  2401
        ]
cg@2744
  2402
cg@2744
  2403
    ] ifFalse:[
cg@2744
  2404
        layout isRectangle ifTrue:[
cg@2744
  2405
            layout setLeft:(layout left + l).
cg@2744
  2406
            layout  setTop:(layout top  + t).
cg@2744
  2407
        ] ifFalse:[
cg@2744
  2408
            layout isPoint ifFalse:[^ self].
cg@2744
  2409
            layout x:(layout x + l) y:(layout y + t).
cg@2744
  2410
        ]
cg@2744
  2411
    ].
cg@2744
  2412
    widget geometryLayout:layout.
cg@2744
  2413
!
cg@2744
  2414
cg@2744
  2415
resizeLeft:l top:t right:r bottom:b
cg@2744
  2416
    "resize the widget measured in pixels
cg@2744
  2417
    "
cg@2744
  2418
    |layout|
cg@2744
  2419
cg@2744
  2420
    self isResizeable ifFalse:[
cg@2744
  2421
        ^ self
cg@2744
  2422
    ].
cg@2744
  2423
cg@2744
  2424
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  2425
        "Extent"
cg@2744
  2426
        (r == l and:[b == t]) ifFalse:[
cg@2744
  2427
            widget extent:(widget computeExtent + ((r-l) @ (b-t))).
cg@2744
  2428
        ].
cg@2744
  2429
        ^ self
cg@2744
  2430
    ].
cg@2744
  2431
cg@2744
  2432
    layout isLayout ifTrue:[
cg@2744
  2433
        layout := layout copy.
cg@2744
  2434
cg@2744
  2435
        layout leftOffset:(layout leftOffset + l)
cg@2744
  2436
                topOffset:(layout topOffset  + t).
cg@2744
  2437
cg@2744
  2438
        layout isLayoutFrame ifTrue:[
cg@2744
  2439
            layout bottomOffset:(layout bottomOffset + b).
cg@2744
  2440
            layout  rightOffset:(layout rightOffset  + r).
cg@2744
  2441
        ]
cg@2744
  2442
    ] ifFalse:[
cg@2744
  2443
        layout isRectangle ifFalse:[^ self].
cg@2744
  2444
        layout := layout copy.
cg@2744
  2445
cg@2744
  2446
        layout left:(layout left   + l)
cg@2744
  2447
              right:(layout right  + r)
cg@2744
  2448
                top:(layout top    + t)
cg@2744
  2449
             bottom:(layout bottom + b).
cg@2744
  2450
    ].
cg@2744
  2451
    widget geometryLayout:layout.
cg@2744
  2452
! !
cg@2744
  2453
cg@2744
  2454
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
cg@2744
  2455
cg@2744
  2456
updateChildren
cg@2744
  2457
    |list|
cg@2744
  2458
cg@2744
  2459
    self do:[:el|
cg@2744
  2460
        el exists ifTrue:[
cg@2744
  2461
            el updateChildren.
cg@2744
  2462
        ] ifFalse:[
cg@2744
  2463
            list isNil ifTrue:[list := OrderedCollection new].
cg@2744
  2464
            list add:el.
cg@2744
  2465
        ]
cg@2744
  2466
    ].
cg@2744
  2467
    list notNil ifTrue:[
cg@2744
  2468
        list do:[:el| self remove:el ].
cg@2744
  2469
    ].
cg@2744
  2470
!
cg@2744
  2471
cg@2744
  2472
updateFromChildren:mergedList
cg@2744
  2473
    "update my children against the list of items derived from
cg@2744
  2474
     the merged list.
cg@2744
  2475
    "
cg@2744
  2476
cg@2744
  2477
    mergedList size == 0 ifTrue:[ ^ self removeAll ].
cg@2744
  2478
    children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
cg@2744
  2479
cg@2744
  2480
    self criticalDo:[
cg@2744
  2481
        self nonCriticalDo:[:el| |wdg|
cg@2744
  2482
            wdg := el widget.
cg@2744
  2483
            mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
cg@2744
  2484
        ].
cg@2744
  2485
cg@2744
  2486
        mergedList keysAndValuesDo:[:i :el| |wdg e2|
cg@2744
  2487
            wdg := el widget.
cg@2744
  2488
cg@2744
  2489
            e2  := self at:i ifAbsent:nil.
cg@2744
  2490
cg@2744
  2491
            (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
cg@2744
  2492
                self add:el beforeIndex:i
cg@2744
  2493
            ]
cg@2744
  2494
        ]
cg@2744
  2495
    ].
cg@2744
  2496
! !
cg@2744
  2497
cg@2744
  2498
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
cg@2744
  2499
cg@2744
  2500
icon
cg@2744
  2501
    "get the icon used for presentation
cg@2744
  2502
    "
cg@2744
  2503
    |specClass model|
cg@2744
  2504
cg@2744
  2505
    specClass := self specClass.
cg@2744
  2506
    specClass isNil ifTrue:[^ nil].
cg@2744
  2507
cg@2744
  2508
    model := self treeModel.
cg@2744
  2509
cg@2744
  2510
    model notNil ifTrue:[
cg@2744
  2511
        ^ model iconAt:specClass ifNonePut:[specClass icon]
cg@2744
  2512
    ].
cg@2744
  2513
    ^ specClass icon
cg@2744
  2514
!
cg@2744
  2515
cg@2744
  2516
label
cg@2744
  2517
    "get the label used for presentation
cg@2744
  2518
    "
cg@2744
  2519
    ^ self string
cg@2744
  2520
!
cg@2744
  2521
cg@2744
  2522
printOn:aStream
cg@2744
  2523
    "append a a printed representation of the item to aStream
cg@2744
  2524
    "
cg@2744
  2525
    aStream nextPutAll:(self string)
cg@2744
  2526
!
cg@2744
  2527
cg@2744
  2528
string
cg@2744
  2529
    "get the string
cg@2744
  2530
    "
cg@2744
  2531
    ^ widget class name.
cg@2744
  2532
! !
cg@2744
  2533
cg@2744
  2534
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
cg@2744
  2535
cg@2744
  2536
canChangeLayout
cg@2744
  2537
    "returns true if the layout of the widget can be changed and the
cg@2744
  2538
     layout is not organized by its superView
cg@2744
  2539
    "
cg@2744
  2540
    ^ self isResizeable
cg@2744
  2541
!
cg@2744
  2542
cg@2744
  2543
canResizeSubComponents
cg@2744
  2544
    "returns true if the widget can resize its sub components
cg@2744
  2545
    "
cg@2744
  2546
    |specClass|
cg@2744
  2547
cg@2744
  2548
    specClass := self specClass.
cg@2744
  2549
cg@2744
  2550
    specClass notNil ifTrue:[
cg@2744
  2551
        ^ specClass canResizeSubComponents
cg@2744
  2552
    ].
cg@2744
  2553
    ^ false
cg@2744
  2554
!
cg@2744
  2555
cg@2744
  2556
exists
cg@2744
  2557
    widget id notNil ifTrue:[^ true ].
cg@2744
  2558
cg@2744
  2559
    exists ~~ false ifTrue:[
cg@2744
  2560
        exists := false.
cg@2744
  2561
cg@2744
  2562
        widget superView notNil ifTrue:[
cg@2744
  2563
            (parent isHierarchicalItem and:[parent exists]) ifTrue:[
cg@2744
  2564
                exists := (parent widget subViews includesIdentical:widget).
cg@2744
  2565
            ].
cg@2744
  2566
        ].
cg@2744
  2567
    ].
cg@2744
  2568
    ^ exists
cg@2744
  2569
!
cg@2744
  2570
cg@2744
  2571
isApplicationClass
cg@2744
  2572
    |cls|
cg@2744
  2573
cg@2744
  2574
    cls := widget class.
cg@2744
  2575
cg@2744
  2576
    ^ (    cls == ApplicationSubView
cg@2744
  2577
        or:[cls == ApplicationWindow
cg@2744
  2578
        or:[cls == SubCanvas]]
cg@2744
  2579
      ) 
cg@2744
  2580
!
cg@2744
  2581
cg@2744
  2582
isSelected
cg@2744
  2583
    |model|
cg@2744
  2584
cg@2744
  2585
    model := self treeModel.
cg@2744
  2586
    model notNil ifTrue:[^ model isSelected:self].
cg@2744
  2587
    ^ false
cg@2744
  2588
!
cg@2744
  2589
cg@2744
  2590
supportsSubComponents
cg@2744
  2591
    "returns true if the widget supports sub components
cg@2744
  2592
    "
cg@2744
  2593
    |specClass|
cg@2744
  2594
cg@2744
  2595
    widget isScrollWrapper ifTrue:[
cg@2744
  2596
        ^ false
cg@2744
  2597
    ].
cg@2744
  2598
    specClass := self specClass.
cg@2744
  2599
cg@2744
  2600
    specClass notNil ifTrue:[
cg@2744
  2601
        ^ specClass supportsSubComponents
cg@2744
  2602
    ].
cg@2744
  2603
    ^ false
cg@2744
  2604
! !
cg@2744
  2605
cg@2744
  2606
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
cg@2744
  2607
cg@2744
  2608
isInLayoutContainer
cg@2744
  2609
    "returns true if the widget is in a layout container
cg@2744
  2610
    "
cg@2744
  2611
    |sv specClass|
cg@2744
  2612
cg@2744
  2613
    sv := widget superView.
cg@2744
  2614
cg@2744
  2615
    sv notNil ifTrue:[
cg@2744
  2616
        specClass := sv specClass.
cg@2744
  2617
cg@2744
  2618
        specClass notNil ifTrue:[
cg@2744
  2619
            ^ specClass isLayoutContainer
cg@2744
  2620
        ].
cg@2744
  2621
    ].
cg@2744
  2622
    ^ false
cg@2744
  2623
!
cg@2744
  2624
cg@2744
  2625
isLayoutContainer
cg@2744
  2626
    "answer whether corresponding view instances of the spec class can contain
cg@2744
  2627
     (and arrange) other view
cg@2744
  2628
    "
cg@2744
  2629
    |specClass|
cg@2744
  2630
cg@2744
  2631
    specClass := self specClass.
cg@2744
  2632
cg@2744
  2633
    specClass notNil ifTrue:[
cg@2744
  2634
        ^ specClass isLayoutContainer
cg@2744
  2635
    ].
cg@2744
  2636
    ^ false
cg@2744
  2637
!
cg@2744
  2638
cg@2744
  2639
isMoveable
cg@2744
  2640
    "returns true if the widget is not in a layout container
cg@2744
  2641
    "
cg@2744
  2642
    self isInLayoutContainer ifFalse:[
cg@2744
  2643
        ^ widget superView notNil
cg@2744
  2644
    ].
cg@2744
  2645
    ^ false
cg@2744
  2646
!
cg@2744
  2647
cg@2744
  2648
isResizeable
cg@2744
  2649
    "returns true if the widget is resizeable
cg@2744
  2650
    "
cg@2744
  2651
    |sv specClass|
cg@2744
  2652
cg@2744
  2653
    sv := widget superView.
cg@2744
  2654
cg@2744
  2655
    sv notNil ifTrue:[
cg@2744
  2656
        specClass := sv specClass.
cg@2744
  2657
cg@2744
  2658
        specClass notNil ifTrue:[
cg@2744
  2659
            ^ specClass canResizeSubComponents
cg@2744
  2660
        ].
cg@2744
  2661
    ].
cg@2744
  2662
    ^ false
cg@2744
  2663
! !
cg@2744
  2664
cg@2744
  2665
!ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
cg@2744
  2666
cg@2744
  2667
documentation
cg@2744
  2668
"
cg@2744
  2669
    Instances of ViewTreeModel can be used as model on a View and all
cg@2744
  2670
    it contained subviews for a HierarchicalListView.
cg@2744
  2671
    The model keeps two values, the hierarchical representation of the views
cg@2744
  2672
    and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
cg@2744
  2673
    It shows the selected items highlighted.
cg@2744
  2674
cg@2744
  2675
cg@2744
  2676
    [Instance variables:]
cg@2744
  2677
        lockSema            <Semaphore>         lock selection notifications and redraws
cg@2744
  2678
cg@2744
  2679
        testModeChannel     <ValueHolder>       true, than running in test mode.
cg@2744
  2680
cg@2744
  2681
        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
cg@2744
  2682
cg@2744
  2683
        selection           <Sequence or nil>   selected items or nil
cg@2744
  2684
cg@2744
  2685
        hiddenLevel         <Integer>           internal use; redrawing the selection
cg@2744
  2686
                                                only is done if the counter is 0.
cg@2744
  2687
cg@2744
  2688
        listOfItems         <HierarchicalList>  hiearchical list build from existing items.
cg@2744
  2689
cg@2744
  2690
        selectedSuperItems  <Sequence>          list of selected super items; items selected
cg@2744
  2691
                                                but not contained in another selected item.
cg@2744
  2692
cg@2744
  2693
        inputEventAction    <Action>            called for each InputEvent
cg@2744
  2694
cg@2744
  2695
        mappedViewAction    <Action>            called for a new mapped view which
cg@2744
  2696
                                                can not be found in the current item list.
cg@2744
  2697
cg@2744
  2698
        beforeSelectionChangedAction <Action>   called before the selection changed
cg@2744
  2699
cg@2744
  2700
    [author:]
cg@2744
  2701
        Claus Atzkern
cg@2744
  2702
cg@2744
  2703
    [see also:]
cg@2744
  2704
        ViewTreeItem
cg@2744
  2705
"
cg@2744
  2706
!
cg@2744
  2707
cg@2744
  2708
examples
cg@2744
  2709
"
cg@2744
  2710
    example 1: pick any window and show views and contained views
cg@2744
  2711
                                                                                [exBegin]
cg@2744
  2712
    |top sel model panel|
cg@2744
  2713
cg@2744
  2714
    model := ViewTreeModel new.
cg@2744
  2715
    top   := StandardSystemView new; extent:440@400.
cg@2744
  2716
    sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
cg@2744
  2717
    sel bottomInset:24.
cg@2744
  2718
cg@2744
  2719
    panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
cg@2744
  2720
    panel topInset:-24.
cg@2744
  2721
    panel horizontalLayout:#fitSpace.
cg@2744
  2722
cg@2744
  2723
    Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
cg@2744
  2724
    Button label:'Pick Views' action:[  |win|
cg@2744
  2725
                                        (     (win := Screen current viewFromUser) notNil
cg@2744
  2726
                                         and:[(win := win topView) ~~ Screen current rootView
cg@2744
  2727
                                         and:[win ~~ top]]
cg@2744
  2728
                                        ) ifTrue:[
cg@2744
  2729
                                            model rootItem:(ViewTreeItem buildViewsFrom:win)
cg@2744
  2730
                                        ] ifFalse:[
cg@2744
  2731
                                            model rootItem:nil
cg@2744
  2732
                                        ]
cg@2744
  2733
                                     ] in:panel.
cg@2744
  2734
cg@2744
  2735
    sel  multipleSelectOk:true.
cg@2744
  2736
    sel              list:model listOfItems.
cg@2744
  2737
    sel             model:model.
cg@2744
  2738
    sel          useIndex:false.
cg@2744
  2739
cg@2744
  2740
    sel doubleClickAction:[:i| |el|
cg@2744
  2741
        el := model listOfItems at:i.
cg@2744
  2742
        el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
cg@2744
  2743
    ].
cg@2744
  2744
    sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
cg@2744
  2745
cg@2744
  2746
    model inputEventAction:[:anEvent| |item|
cg@2744
  2747
        anEvent isButtonEvent ifTrue:[
cg@2744
  2748
            anEvent isButtonPressEvent ifTrue:[
cg@2744
  2749
                model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
cg@2744
  2750
            ] ifFalse:[
cg@2744
  2751
                anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
cg@2744
  2752
                    (item := model selectedItem) notNil ifTrue:[item widget inspect]
cg@2744
  2753
                ]
cg@2744
  2754
            ]
cg@2744
  2755
        ]
cg@2744
  2756
    ].
cg@2744
  2757
cg@2744
  2758
    top openAndWait.
cg@2744
  2759
    [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
cg@2744
  2760
cg@2744
  2761
                                                                                [exEnd]
cg@2744
  2762
"
cg@2744
  2763
! !
cg@2744
  2764
cg@2744
  2765
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
cg@2744
  2766
cg@2744
  2767
application:anApplication
cg@2744
  2768
    listOfItems application:anApplication.
cg@2744
  2769
!
cg@2744
  2770
cg@2744
  2771
rootItem
cg@2744
  2772
    "get the rootItem the event viewer is established on
cg@2744
  2773
    "
cg@2744
  2774
    ^ listOfItems root
cg@2744
  2775
!
cg@2744
  2776
cg@2744
  2777
rootItem:anItem
cg@2744
  2778
    "set the rootItem the event viewer is established on
cg@2744
  2779
    "
cg@2744
  2780
    |expanded|
cg@2744
  2781
cg@2744
  2782
    timedUpdateTask := nil.
cg@2744
  2783
    self deselect.
cg@2744
  2784
cg@2744
  2785
    lockSema critical:[
cg@2744
  2786
        anItem notNil ifTrue:[ expanded := anItem isExpanded ]
cg@2744
  2787
                     ifFalse:[ expanded := false ].
cg@2744
  2788
cg@2744
  2789
        self value:nil.
cg@2744
  2790
        listOfItems root:anItem.
cg@2744
  2791
cg@2744
  2792
        anItem notNil ifTrue:[
cg@2744
  2793
            timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
cg@2744
  2794
            timedUpdateTask name:'Update'.
cg@2744
  2795
            timedUpdateTask resume.
cg@2744
  2796
        ].
cg@2744
  2797
    ].