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