Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 30 Apr 2013 15:12:51 +0200
changeset 3000 7b530cc76688
parent 2978 a952dfdb1b6a
child 3014 05208490cea6
permissions -rw-r--r--
class: Tools::ViewTreeInspectorApplication
added: #releaseViewIcon
changed: #toolbarMenu
     1 "
     2  COPYRIGHT (c) 2007 by eXept Software AG
     3               All Rights Reserved
     4 
     5  This software is furnished under a license and may be used
     6  only in accordance with the terms of that license and with the
     7  inclusion of the above copyright notice.   This software may not
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    11 "
    12 "{ Package: 'stx:libtool2' }"
    13 
    14 "{ NameSpace: Tools }"
    15 
    16 ToolApplicationModel subclass:#ViewTreeInspectorApplication
    17 	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
    18 		motionAction process followFocusChannel showNamesHolder
    19 		inspectorView'
    20 	classVariableNames:''
    21 	poolDictionaries:''
    22 	category:'Interface-Smalltalk'
    23 !
    24 
    25 Object subclass:#MenuDesc
    26 	instanceVariableNames:'title value action'
    27 	classVariableNames:''
    28 	poolDictionaries:''
    29 	privateIn:ViewTreeInspectorApplication
    30 !
    31 
    32 HierarchicalItem subclass:#ViewTreeItem
    33 	instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
    34 	classVariableNames:'HandleExtent'
    35 	poolDictionaries:''
    36 	privateIn:ViewTreeInspectorApplication
    37 !
    38 
    39 ValueModel subclass:#ViewTreeModel
    40 	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
    41 		inputEventAction mappedViewAction beforeSelectionChangedAction
    42 		icons timedUpdateTask selectOnClickHolder testModeChannel
    43 		hasTargetWidgetChannel catchEvents'
    44 	classVariableNames:''
    45 	poolDictionaries:''
    46 	privateIn:ViewTreeInspectorApplication
    47 !
    48 
    49 HierarchicalList subclass:#ItemList
    50 	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
    51 	classVariableNames:''
    52 	poolDictionaries:''
    53 	privateIn:ViewTreeInspectorApplication::ViewTreeModel
    54 !
    55 
    56 !ViewTreeInspectorApplication class methodsFor:'documentation'!
    57 
    58 copyright
    59 "
    60  COPYRIGHT (c) 2007 by eXept Software AG
    61               All Rights Reserved
    62 
    63  This software is furnished under a license and may be used
    64  only in accordance with the terms of that license and with the
    65  inclusion of the above copyright notice.   This software may not
    66  be provided or otherwise made available to, or used by, any
    67  other person.  No title to or ownership of the software is
    68  hereby transferred.
    69 "
    70 !
    71 
    72 documentation
    73 "
    74      Small application showing a ViewTreeModel use.
    75 
    76      It displays a hierarchical list of a selected TopView and
    77      all its contained subViews.
    78      Useful to have a look at subcomponents - to see how views
    79      are structured.
    80 
    81 
    82     [Instance variables:]
    83         model           <ViewTreeModel>      the used ViewTreeModel
    84         clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
    85         clickedPoint    <Point>              point where the motion action started from.
    86         motionAction    <Action>             (oneArg-) action called durring buttonMotion.
    87 
    88 
    89     [author:]
    90         Claus Atzkern
    91 
    92     [see also:]
    93         ViewTreeModel
    94         ViewTreeItem
    95 "
    96 ! !
    97 
    98 !ViewTreeInspectorApplication class methodsFor:'initialization'!
    99 
   100 initialize
   101     "add myself to the launcher menu
   102     "
   103     self installInLauncher.
   104 !
   105 
   106 installInLauncher
   107     "add myself to the launcher menu"
   108 
   109     |menuItem icon|
   110 
   111     NewLauncher isNil ifTrue:[^ self].
   112     "/ cg - disabled. the icon is too ugly.
   113     ^ self.
   114 
   115     icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
   116 
   117     menuItem := MenuItem new 
   118                     label: 'View Tree Inspector';
   119                     value: [ ViewTreeInspectorApplication open];
   120                     isButton: true;
   121                     icon: icon;
   122                     nameKey: #viewInspect.
   123 
   124     menuItem startGroup:#right.
   125     NewLauncher addMenuItem:menuItem in:'toolbar'
   126                    position:#( #before #help)
   127                       space:false.
   128 
   129 "
   130 self installInLauncher
   131 self removeFromLauncher
   132 "
   133 !
   134 
   135 postAutoload
   136     "add myself to the launcher menu
   137     "
   138     self installInLauncher.
   139 "
   140 self installInLauncher
   141 self removeFromLauncher
   142 "
   143 !
   144 
   145 removeFromLauncher
   146     "remove myself from the launcher menu
   147     "
   148     NewLauncher isNil ifTrue:[^ self].
   149     NewLauncher removeUserTool:#viewInspect
   150 
   151 "
   152 self installInLauncher
   153 self removeFromLauncher
   154 "
   155 !
   156 
   157 unload
   158     "class is about to be unloaded - remove myself from the launcher menu
   159     "
   160     self removeFromLauncher.
   161     super unload.
   162 ! !
   163 
   164 !ViewTreeInspectorApplication class methodsFor:'image specs'!
   165 
   166 crossHairIcon
   167     "This resource specification was automatically generated
   168      by the ImageEditor of ST/X."
   169 
   170     "Do not manually edit this!! If it is corrupted,
   171      the ImageEditor may not be able to read the specification."
   172 
   173     "
   174      self crossHairIcon inspect
   175      ImageEditor openOnClass:self andSelector:#crossHairIcon
   176      Icon flushCachedIcons
   177     "
   178 
   179     <resource: #image>
   180 
   181     ^Icon
   182         constantNamed:'Tools::ViewTreeInspectorApplication class crossHairIcon'
   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]
   184 !
   185 
   186 pickWindowIcon
   187     "This resource specification was automatically generated
   188      by the ImageEditor of ST/X."
   189 
   190     "Do not manually edit this!! If it is corrupted,
   191      the ImageEditor may not be able to read the specification."
   192 
   193     "
   194      self pickWindowIcon inspect
   195      ImageEditor openOnClass:self andSelector:#pickWindowIcon
   196      Icon flushCachedIcons
   197     "
   198 
   199     <resource: #image>
   200 
   201     ^Icon
   202         constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
   203         ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
   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
   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
   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@
   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@
   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
   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]
   210 !
   211 
   212 pickWindowIcon2
   213     "This resource specification was automatically generated
   214      by the ImageEditor of ST/X."
   215 
   216     "Do not manually edit this!! If it is corrupted,
   217      the ImageEditor may not be able to read the specification."
   218 
   219     "
   220      self pickWindowIcon2 inspect
   221      ImageEditor openOnClass:self andSelector:#pickWindowIcon2
   222      Icon flushCachedIcons
   223     "
   224 
   225     <resource: #image>
   226 
   227     ^Icon
   228         constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon2'
   229         ifAbsentPut:[(Depth8Image new) width: 22; height: 23; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
   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^
   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
   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@@@@
   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$
   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^&) @
   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]
   236 !
   237 
   238 releaseViewIcon
   239     "This resource specification was automatically generated
   240      by the ImageEditor of ST/X."
   241 
   242     "Do not manually edit this!! If it is corrupted,
   243      the ImageEditor may not be able to read the specification."
   244 
   245     "
   246      self releaseViewIcon inspect
   247      ImageEditor openOnClass:self andSelector:#releaseViewIcon
   248      Icon flushCachedIcons
   249     "
   250 
   251     <resource: #image>
   252 
   253     ^Icon
   254         constantNamed:'Tools::ViewTreeInspectorApplication releaseViewIcon'
   255         ifAbsentPut:[(Depth8Image new) width: 24; height: 24; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
   256 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
   257 @@@@@@@@@@@@@@A8^G!!7O3ACP5*P@@A8^G @@@@@@@@@@@A8^@@@OE0/!!P0S#0@@^G @@@@@@@@@@@B (@@''D#48"1.CX5H@(J@@@@@@@@@@@@B (@@@@@@"
   258 ''%!!/P7,@(J@@@@@@@@@@@@@%I@@@@BH%IRTQV5P@IRT@@@@@@@@@@@ANSP@@@@ANS$8:T80@S$8@@@@@@@@@@@AN&UYWK(EYQ@\FUPQHXT8@@@@@@@@@@@AN
   259 HC2!!TVY:Y#-%I*IKMD8@@@@@@@@@@@A$\@83XBEG%).GGX _!!&P@@@@@@@@@@@AO[P5+ &(WPYN@["!!E\$<@@@@@@@@@@@B_F''FQPAXX_!!&TGH4HB9<@@@@@
   260 @@@@@@B_%3HCJ7=BKPU,Q)01B9<@@@@@@@@@@@@PBP8T_F!!''JPI)_Y"D&!!@@@@@@@@@@@@@$B)I9TGXO''WQIWQ93W0@@@@@@@@@@@@@$"U=JR$)JR$)JR$)_
   261 "P@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
   262 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@') ; colorMapFromArray:#[132 141 152 147 150 154 250 223 1 246 214 0 205 172 133 238 195 0 213 180 146 217 186 150 188 136 0 206 151 0 183 125 9 208 208 202 196 204 214 255 255 210 255 255 219 210 178 65 242 242 235 106 112 117 96 107 126 250 255 255 255 241 0 154 154 151 255 227 0 67 35 0 52 17 0 253 211 0 208 159 0 167 178 193 222 168 0 248 231 45 208 174 26 199 152 26 225 184 36 255 249 75 220 220 215 77 88 108 241 241 235 245 245 239 255 250 109 242 249 255 255 255 142 255 237 1 142 148 162 242 212 1 143 154 176 174 133 0 222 189 144 169 179 192 177 184 193 184 129 0 255 255 194 253 241 60 210 210 205 214 214 209 77 83 92 230 230 225 98 106 114 243 243 238 117 117 114 255 252 115 255 255 255 115 123 147 130 140 156 152 156 159 241 210 0 53 18 0 151 116 0 162 170 184 218 187 150 193 143 4 220 165 0 206 188 46 181 130 21 204 173 44 206 206 201 208 167 44 72 84 108 240 240 234 244 244 238 243 243 237 212 182 79 255 255 126 131 135 141 119 133 159 132 141 163 195 162 126 219 188 133 218 185 135 180 180 176 221 190 150 175 181 191 176 183 196 181 189 201 202 170 38 209 209 204 207 207 202 251 241 74 229 229 224 238 238 233 226 234 245 244 244 237 255 251 113 255 255 124 255 241 2 255 234 3 249 219 0 255 249 29 252 243 30 227 181 0 212 165 5 222 170 0 173 179 194 216 171 19 255 255 198 208 208 203 156 90 7 206 175 50 91 91 95 211 180 71 242 242 237 246 246 241 212 182 80 255 255 123 129 137 152 255 239 8 251 223 0 59 25 0 251 215 0 228 183 0 222 191 149 249 238 43 177 186 197 187 129 0 186 194 206 209 209 203 249 238 67 255 255 211 226 226 221 235 235 229 100 103 111 76 93 127 255 255 112 88 104 139 130 135 148 149 155 158 247 218 0 224 194 126 255 217 0 228 184 0 13 30 68 161 138 32 204 152 0 255 255 53 206 155 18 207 207 201 255 250 72 255 255 82 209 176 59 232 232 227 243 243 236 245 245 240 255 255 115 255 255 251]; mask:((Depth1Image new) width: 24; height: 24; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@G8@@O<@@O>@@@^@@@N@@@N@@?? @?? @?? @?? @?? @?? @?? @?? @_?@@@@@@@@@@@@@@@@@@@@@') ; yourself); yourself]
   263 ! !
   264 
   265 !ViewTreeInspectorApplication class methodsFor:'interface specs'!
   266 
   267 windowSpec
   268     "This resource specification was automatically generated
   269      by the UIPainter of ST/X."
   270 
   271     "Do not manually edit this!! If it is corrupted,
   272      the UIPainter may not be able to read the specification."
   273 
   274     "
   275      UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec
   276      Tools::ViewTreeInspectorApplication new openInterface:#windowSpec
   277      Tools::ViewTreeInspectorApplication open
   278     "
   279 
   280     <resource: #canvas>
   281 
   282     ^ 
   283      #(FullSpec
   284         name: windowSpec
   285         window: 
   286        (WindowSpec
   287           label: 'View Tree Inspector'
   288           name: 'View Tree Inspector'
   289           min: (Point 10 10)
   290           max: (Point 1024 9999)
   291           bounds: (Rectangle 0 0 381 654)
   292           menu: menu
   293         )
   294         component: 
   295        (SpecCollection
   296           collection: (
   297            (MenuPanelSpec
   298               name: 'toolbarMenu'
   299               layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
   300               menu: toolbarMenu
   301               textDefault: true
   302             )
   303        (VariableVerticalPanelSpec
   304               name: 'VariableVerticalPanel1'
   305               layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
   306               component: 
   307              (SpecCollection
   308                 collection: (
   309                  (HierarchicalListViewSpec
   310                     name: 'List'
   311                     level: 1
   312                     model: model
   313                     menu: middleButtonMenu
   314                     hasHorizontalScrollBar: true
   315                     hasVerticalScrollBar: true
   316                     miniScrollerHorizontal: true
   317                     miniScrollerVertical: false
   318                     listModel: listOfItems
   319                     multipleSelectOk: true
   320                     useIndex: false
   321                     highlightMode: label
   322                     showLeftIndicators: false
   323                     indicatorSelector: indicatorClicked:
   324                     useDefaultIcons: false
   325                     postBuildCallback: postBuildTree:
   326                   )
   327                  (ViewSpec
   328                     name: 'Box1'
   329                     viewClassName: 'InspectorView'
   330                     postBuildCallback: postBuildInspectorView:
   331                   )
   332                  )
   333                
   334               )
   335               handles: (Any 0.5 1.0)
   336             )
   337            )
   338          
   339         )
   340       )
   341 ! !
   342 
   343 !ViewTreeInspectorApplication class methodsFor:'menu specs'!
   344 
   345 menu
   346     "This resource specification was automatically generated
   347      by the MenuEditor of ST/X."
   348 
   349     "Do not manually edit this!! If it is corrupted,
   350      the MenuEditor may not be able to read the specification."
   351 
   352 
   353     "
   354      MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#menu
   355      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication menu)) startUp
   356     "
   357 
   358     <resource: #menu>
   359 
   360     ^ 
   361      #(Menu
   362         (
   363          (MenuItem
   364             label: 'File'
   365             submenu: 
   366            (Menu
   367               (
   368                (MenuItem
   369                   label: 'Pick a View'
   370                   itemValue: doPickView
   371                 )
   372                (MenuItem
   373                   enabled: hasTargetWidgetChannel
   374                   label: 'Release Picked View'
   375                   itemValue: doUnpick
   376                 )
   377                (MenuItem
   378                   label: '-'
   379                 )
   380                (MenuItem
   381                   label: 'Settings'
   382                   submenu: 
   383                  (Menu
   384                     (
   385                      (MenuItem
   386                         label: 'Test Mode'
   387                         hideMenuOnActivated: false
   388                         indication: testModeChannel
   389                       )
   390                      (MenuItem
   391                         enabled: testModeChannel
   392                         label: 'Follow Focus'
   393                         hideMenuOnActivated: false
   394                         indication: followFocusChannel
   395                       )
   396                      (MenuItem
   397                         label: '-'
   398                       )
   399                      (MenuItem
   400                         label: 'Select on Click'
   401                         hideMenuOnActivated: false
   402                         indication: selectOnClickHolder
   403                       )
   404                      (MenuItem
   405                         label: '-'
   406                       )
   407                      (MenuItem
   408                         label: 'Show Name of Widgets'
   409                         hideMenuOnActivated: false
   410                         indication: showNamesHolder
   411                       )
   412                      )
   413                     nil
   414                     nil
   415                   )
   416                 )
   417                (MenuItem
   418                   label: '-'
   419                 )
   420                (MenuItem
   421                   label: 'Exit'
   422                   itemValue: closeRequest
   423                 )
   424                )
   425               nil
   426               nil
   427             )
   428           )
   429          (MenuItem
   430             enabled: hasSingleSelectionHolder
   431             label: 'Selection'
   432             submenuChannel: middleButtonMenu
   433           )
   434          (MenuItem
   435             label: 'Application'
   436             submenu: 
   437            (Menu
   438               (
   439                (MenuItem
   440                   label: 'Redraw'
   441                   itemValue: doRedraw
   442                 )
   443                (MenuItem
   444                   label: '-'
   445                 )
   446                (MenuItem
   447                   enabled: hasSingleSelectionHolder
   448                   label: 'Browse'
   449                   itemValue: doBrowse:
   450                   argument: application
   451                 )
   452                (MenuItem
   453                   enabled: hasSingleSelectionHolder
   454                   label: 'Inspect'
   455                   itemValue: doInspect:
   456                   argument: application
   457                 )
   458                (MenuItem
   459                   label: '-'
   460                 )
   461                (MenuItem
   462                   enabled: hasTargetWidgetChannel
   463                   label: 'All Applications'
   464                   submenuChannel: submenuApplications:
   465                 )
   466                )
   467               nil
   468               nil
   469             )
   470           )
   471          (MenuItem
   472             label: 'Widget'
   473             submenu: 
   474            (Menu
   475               (
   476                (MenuItem
   477                   enabled: hasSingleSelectionHolder
   478                   label: 'Browse'
   479                   itemValue: doBrowse:
   480                   argument: view
   481                 )
   482                (MenuItem
   483                   enabled: hasSingleSelectionHolder
   484                   label: 'Inspect'
   485                   itemValue: doInspect:
   486                   argument: view
   487                 )
   488                (MenuItem
   489                   label: '-'
   490                 )
   491                (MenuItem
   492                   enabled: hasTargetWidgetChannel
   493                   label: 'All Components'
   494                   startGroup: right
   495                   submenuChannel: submenuComponents:
   496                 )
   497                )
   498               nil
   499               nil
   500             )
   501           )
   502          (MenuItem
   503             label: 'Help'
   504             startGroup: conditionalRight
   505             submenu: 
   506            (Menu
   507               (
   508                (MenuItem
   509                   label: 'Documentation'
   510                   itemValue: openDocumentation
   511                 )
   512                (MenuItem
   513                   label: '-'
   514                 )
   515                (MenuItem
   516                   label: 'About this Application...'
   517                   itemValue: openAboutThisApplication
   518                 )
   519                )
   520               nil
   521               nil
   522             )
   523           )
   524          )
   525         nil
   526         nil
   527       )
   528 !
   529 
   530 middleButtonMenu
   531     "This resource specification was automatically generated
   532      by the MenuEditor of ST/X."
   533 
   534     "Do not manually edit this!! If it is corrupted,
   535      the MenuEditor may not be able to read the specification."
   536 
   537     "
   538      MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
   539      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
   540     "
   541 
   542     <resource: #menu>
   543 
   544     ^ 
   545      #(Menu
   546         (
   547          (MenuItem
   548             label: 'Geometry'
   549             translateLabel: true
   550             submenuChannel: submenuGeometry:
   551             keepLinkedMenu: true
   552           )
   553          (MenuItem
   554             label: 'Interface'
   555             translateLabel: true
   556             submenuChannel: submenuInterface:
   557             keepLinkedMenu: true
   558           )
   559          (MenuItem
   560             label: 'Visibility'
   561             translateLabel: true
   562             submenuChannel: submenuVisibility:
   563             keepLinkedMenu: true
   564           )
   565          (MenuItem
   566             label: '-'
   567           )
   568          (MenuItem
   569             label: 'Browse View Class'
   570             itemValue: doBrowse:
   571             translateLabel: true
   572             argument: view
   573           )
   574          (MenuItem
   575             label: 'Browse Model Class'
   576             itemValue: doBrowse:
   577             translateLabel: true
   578             isVisible: hasModel
   579             argument: model
   580           )
   581          (MenuItem
   582             label: 'Browse Application Class'
   583             itemValue: doBrowse:
   584             translateLabel: true
   585             isVisible: hasApplication
   586             argument: application
   587           )
   588          (MenuItem
   589             label: 'Browse Controller Class'
   590             itemValue: doBrowse:
   591             translateLabel: true
   592             isVisible: hasController
   593             argument: controller
   594           )
   595          (MenuItem
   596             label: '-'
   597           )
   598          (MenuItem
   599             label: 'Inspect View'
   600             itemValue: doInspect:
   601             translateLabel: true
   602             argument: view
   603           )
   604          (MenuItem
   605             label: 'Inspect Window Group'
   606             itemValue: doInspect:
   607             translateLabel: true
   608             argument: group
   609           )
   610          (MenuItem
   611             label: 'Inspect Model'
   612             itemValue: doInspect:
   613             translateLabel: true
   614             isVisible: hasModel
   615             argument: model
   616           )
   617          (MenuItem
   618             label: 'Inspect Application'
   619             itemValue: doInspect:
   620             translateLabel: true
   621             isVisible: hasApplication
   622             argument: application
   623           )
   624          (MenuItem
   625             label: 'Inspect Controller'
   626             itemValue: doInspect:
   627             translateLabel: true
   628             isVisible: hasController
   629             argument: controller
   630           )
   631          (MenuItem
   632             label: '-'
   633           )
   634          (MenuItem
   635             label: 'Flash'
   636             itemValue: doFlash
   637             translateLabel: true
   638           )
   639          (MenuItem
   640             label: '-'
   641           )
   642          (MenuItem
   643             label: 'Destroy'
   644             itemValue: doDestroy
   645             translateLabel: true
   646           )
   647          (MenuItem
   648             label: '-'
   649           )
   650          (MenuItem
   651             label: 'Instance Variables'
   652             translateLabel: true
   653             submenuChannel: submenuInspector:
   654             keepLinkedMenu: true
   655           )
   656          (MenuItem
   657             label: '='
   658           )
   659          (MenuItem
   660             label: ''
   661           )
   662          (MenuItem
   663             enabled: selectedComponentHasChildren
   664             label: 'Applications'
   665             nameKey: single
   666             translateLabel: true
   667             submenuChannel: submenuApplications:
   668             keepLinkedMenu: true
   669           )
   670          (MenuItem
   671             enabled: selectedComponentHasChildren
   672             label: 'Components'
   673             nameKey: single
   674             translateLabel: true
   675             submenuChannel: submenuComponents:
   676             keepLinkedMenu: true
   677           )
   678          )
   679         nil
   680         nil
   681       )
   682 !
   683 
   684 toolbarMenu
   685     "This resource specification was automatically generated
   686      by the MenuEditor of ST/X."
   687 
   688     "Do not manually edit this!! If it is corrupted,
   689      the MenuEditor may not be able to read the specification."
   690 
   691 
   692     "
   693      MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu
   694      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp
   695     "
   696 
   697     <resource: #menu>
   698 
   699     ^ 
   700      #(Menu
   701         (
   702          (MenuItem
   703             enabled: hasTargetWidgetChannel
   704             label: 'Redraw'
   705             itemValue: doRedraw
   706             isButton: true
   707             labelImage: (ResourceRetriever ToolbarIconLibrary reloadIcon)
   708           )
   709          (MenuItem
   710             label: '-'
   711           )
   712          (MenuItem
   713             label: 'Pick a View and Catch Events'
   714             itemValue: doPickView
   715             translateLabel: false
   716             isButton: true
   717             hideMenuOnActivated: false
   718             labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon2)
   719           )
   720          (MenuItem
   721             enabled: hasTargetWidgetChannel
   722             label: 'Release Picked View and Uncatch Events'
   723             itemValue: doUncatchEvents
   724             isButton: true
   725             labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' releaseViewIcon)
   726           )
   727          (MenuItem
   728             label: '-'
   729           )
   730          (MenuItem
   731             enabled: hasSingleSelectionHolder
   732             label: 'Browse Application'
   733             itemValue: doBrowse:
   734             translateLabel: false
   735             isButton: true
   736             hideMenuOnActivated: false
   737             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
   738             argument: application
   739           )
   740          (MenuItem
   741             enabled: hasSingleSelectionHolder
   742             label: 'Inspect Application'
   743             itemValue: doInspect:
   744             translateLabel: false
   745             isButton: true
   746             hideMenuOnActivated: false
   747             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
   748             argument: application
   749           )
   750          )
   751         nil
   752         nil
   753       )
   754 ! !
   755 
   756 !ViewTreeInspectorApplication class methodsFor:'startup'!
   757 
   758 openInPickMode
   759     |app|
   760 
   761     app := self new.
   762     app open.
   763     app doPickView.
   764 ! !
   765 
   766 !ViewTreeInspectorApplication methodsFor:'actions'!
   767 
   768 indicatorClicked:anIndex
   769     |item sensor|
   770 
   771     item := model listOfItems at:anIndex ifAbsent:nil.
   772 
   773     item notNil ifTrue:[
   774         (     (sensor := self window sensor) notNil
   775          and:[(sensor ctrlDown or:[sensor shiftDown])]
   776         ) ifTrue:[
   777             item recursiveToggleExpand
   778         ] ifFalse:[
   779             item toggleExpand
   780         ]
   781     ].
   782 ! !
   783 
   784 !ViewTreeInspectorApplication methodsFor:'aspects'!
   785 
   786 followFocusChannel
   787     "boolean holder, which indicates whether selection changed dependend on the focus view"
   788 
   789     ^ followFocusChannel
   790 !
   791 
   792 hasSingleSelectionHolder
   793     "boolean holder, true if one item is selected"
   794 
   795     ^ hasSingleSelectionHolder
   796 !
   797 
   798 hasTargetWidgetChannel
   799     "answer the channel which is set to true if a target widget exists"
   800 
   801     ^ model hasTargetWidgetChannel
   802 !
   803 
   804 listOfItems
   805     "returns the hierarchical list of items"
   806 
   807     ^ model listOfItems
   808 !
   809 
   810 model
   811     "returns my selection model, a ViewTreeModel"
   812 
   813     ^ model
   814 !
   815 
   816 selectOnClickHolder
   817     "boolean holder, which indicates whether the selection will change on click"
   818 
   819     ^ model selectOnClickHolder
   820 !
   821 
   822 showNamesHolder
   823     "boolean holder, which indicates whether application names or widget names
   824      as additional text are shown for the items"
   825 
   826     ^ showNamesHolder
   827 !
   828 
   829 testModeChannel
   830     "answer a boolean channel which describes the behaviour how to process
   831      events on the target view.
   832 
   833      false: all input events are eaten and the selection is shown on the target view.
   834      true:  no  input events are eaten and no  selection is shown on the target view."
   835 
   836     ^ model testModeChannel
   837 ! !
   838 
   839 !ViewTreeInspectorApplication methodsFor:'change & update'!
   840 
   841 selectionChanged
   842     |info view item|
   843 
   844     item := model selectedItem.
   845 
   846     item notNil ifTrue:[ |state|
   847         view := item widget.
   848 
   849         view id isNil ifTrue:[
   850             state := 'no ID'.
   851         ] ifFalse:[
   852             view shown ifTrue:[
   853                 state := 'visible'.
   854             ] ifFalse:[
   855                 state := 'invisible'
   856             ].
   857         ].
   858         info := '%1 [%2] - %3' bindWith:(view class name)
   859                                    with:(view name ? '') with:state allBold.
   860 
   861     ] ifFalse:[
   862         info := ''
   863     ].
   864     hasSingleSelectionHolder value:(view notNil).
   865     inspectorView inspect:view.
   866 !
   867 
   868 update:something with:someArgument from:aModel
   869     |oldSelection|
   870 
   871     aModel == showNamesHolder ifTrue:[
   872         oldSelection := model selectedItem.
   873         model selectedItem:nil.
   874         self listOfItems showWidgetNames:(aModel value).
   875         model selectedItem:oldSelection.
   876         ^ self
   877     ].
   878 
   879     aModel == model ifTrue:[
   880         self selectionChanged.
   881         ^ self
   882     ].
   883 
   884     super update:something with:someArgument from:aModel.
   885 ! !
   886 
   887 !ViewTreeInspectorApplication methodsFor:'event processing'!
   888 
   889 processButtonMotionEvent:ev
   890     |click rootView|
   891 
   892     motionAction isNil ifTrue:[^ self].
   893 
   894     (rootView := model rootView) isNil ifTrue:[
   895         clickedItem := motionAction := nil.
   896         ^ self
   897     ].
   898 
   899     click := rootView device
   900             translatePoint:((ev x)@ (ev y))
   901             fromView:(ev view)
   902             toView:rootView.
   903 
   904     click = clickedPoint ifFalse:[
   905         (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
   906             motionAction value:click
   907         ]
   908     ].
   909 !
   910 
   911 processButtonPressEvent:ev
   912     |rootView sensor lastRectangle|
   913 
   914     rootView    := model rootView.
   915     sensor      := model rootView sensor.
   916     clickedItem := model listOfItems detectItemRespondsToView:(ev view).
   917 
   918     (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
   919         clickedItem notNil ifTrue:[
   920             self selectOnClickHolder value ifTrue:[
   921                 model toggleSelectItem:clickedItem
   922             ].
   923         ].
   924         clickedItem := motionAction := nil.
   925         ^ self
   926     ].
   927 
   928     clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
   929     lastRectangle := nil.
   930 
   931     motionAction :=[:p|
   932         rootView    := model rootView device rootView.
   933         rootView    := model rootView.
   934         clickedItem := nil.
   935 
   936         rootView xoring:[
   937             lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
   938                                 ifFalse:[ rootView clippedByChildren:false ].
   939 
   940             p isNil ifTrue:[
   941                 rootView clippedByChildren:true.
   942                 motionAction := nil.
   943             ] ifFalse:[
   944                 lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
   945                 rootView displayRectangle:lastRectangle.
   946             ].
   947             rootView flush.
   948         ].
   949         lastRectangle
   950     ].
   951 !
   952 
   953 processButtonReleaseEvent:anEvent
   954     |rootView rectangle newItems widget origin|
   955 
   956     (rootView := model rootView) isNil ifTrue:[
   957         clickedItem := motionAction := nil.
   958         ^ self
   959     ].
   960     motionAction isNil ifTrue:[ ^ self ].
   961     clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
   962 
   963     rectangle := motionAction value:nil.
   964     rectangle isNil ifTrue:[^ self].
   965 
   966     newItems := OrderedCollection new.
   967 
   968     model rootItem recursiveDo:[:anItem|
   969         widget := anItem widget.
   970         origin := widget originRelativeTo:rootView.
   971 
   972         (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
   973             newItems add:anItem.
   974         ]
   975     ].
   976     model value:newItems.
   977 !
   978 
   979 processEvent:anEvent
   980     |button menu|
   981 
   982     anEvent isKeyPressEvent ifTrue:[ self processKeyPressEvent:anEvent. ^ self  ].
   983     anEvent isButtonEvent  ifFalse:[ ^ self ].
   984 
   985     button := anEvent button.
   986 
   987     (button == 2 or:[button == #menu]) ifTrue:[
   988         motionAction isNil ifTrue:[
   989             anEvent isButtonPressEvent ifTrue:[
   990                 self selectOnClickHolder value ifTrue:[
   991                     menu := self middleButtonMenu value.
   992                     menu notNil ifTrue:[
   993                         menu := MenuPanel 
   994                                     menu:(Menu new fromLiteralArrayEncoding:menu)
   995                                     receiver:self.
   996                         menu startUp.
   997                     ]
   998                 ].
   999             ].
  1000             clickedItem := nil.
  1001         ].
  1002         ^ self
  1003     ].
  1004 
  1005     anEvent isButtonPressEvent  ifTrue:[ self processButtonPressEvent:anEvent. ^ self ].
  1006     anEvent isButtonMotionEvent ifTrue:[ self processButtonMotionEvent:anEvent. ^ self ].
  1007 
  1008     anEvent isButtonReleaseEvent ifTrue:[
  1009         self selectOnClickHolder value ifTrue:[
  1010             self processButtonReleaseEvent:anEvent
  1011         ].
  1012     ].
  1013     clickedItem := motionAction := nil.
  1014 
  1015     anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  1016         self selectOnClickHolder value ifTrue:[
  1017             self doInspect:#view.
  1018         ].
  1019     ].
  1020 !
  1021 
  1022 processKeyPressEvent:anEvent
  1023     |item prnt idx key max next|
  1024 
  1025     key := anEvent key.
  1026     key isSymbol ifFalse:[^ self].
  1027 
  1028     key == #Delete    ifTrue:[ ^ self doDestroy ].
  1029     key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
  1030 
  1031     (   key == #CursorUp
  1032     or:[key == #CursorDown
  1033     or:[key == #CursorLeft
  1034     or:[key == #CursorRight]]]
  1035     ) ifFalse:[
  1036         ^ self
  1037     ].
  1038     item := model selectedItem.
  1039 
  1040     item isNil ifTrue:[
  1041         ^ model selectedItem:(model first ? model rootItem)
  1042     ].
  1043 
  1044     prnt := item parent.
  1045     prnt isNil ifTrue:[
  1046         "/ is the root item
  1047         (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
  1048                                                   ifFalse:[item := item at:1 ifAbsent:item].
  1049 
  1050         ^ model selectedItem:item
  1051     ].
  1052     key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
  1053 
  1054     key == #CursorRight ifTrue:[
  1055         next := item at:1 ifAbsent:nil.
  1056         next notNil ifTrue:[ model selectedItem:next ].
  1057         ^ self
  1058     ].
  1059 
  1060     max := prnt size.
  1061 
  1062     key == #CursorUp ifTrue:[
  1063         idx := prnt identityIndexOf:item.
  1064         idx == 1 ifTrue:[idx := max + 1].
  1065         model selectedItem:(prnt at:idx - 1).
  1066         ^ self.
  1067     ].
  1068 
  1069     key == #CursorDown ifTrue:[
  1070         idx := prnt identityIndexOf:item.
  1071         idx == max ifTrue:[idx := 0].
  1072         model selectedItem:(prnt at:idx + 1).
  1073         ^ self.
  1074     ].
  1075 !
  1076 
  1077 processMappedView:aView
  1078     |parent anchor|
  1079 
  1080     parent := self listOfItems detectItemRespondsToView:aView.
  1081     parent isNil ifTrue:[ ^ self ].
  1082 
  1083     NotFoundSignal handle:[:ex|
  1084         "contained subvies used by spec are not yet created;
  1085          thus we have to wait until last used subview is build
  1086         "
  1087         anchor := nil.
  1088     ] do:[
  1089         anchor := parent class buildViewsFrom:(parent widget).
  1090     ].
  1091     anchor notNil ifTrue:[
  1092         parent updateFromChildren:anchor children.
  1093     ].
  1094 ! !
  1095 
  1096 !ViewTreeInspectorApplication methodsFor:'initialization & release'!
  1097 
  1098 closeDownViews
  1099     "release the grapped application"
  1100 
  1101     process := nil.
  1102     super closeDownViews.
  1103     self doUnpick.
  1104 !
  1105 
  1106 initialize
  1107     "setup my model and channels"
  1108 
  1109     super initialize.
  1110 
  1111     hasSingleSelectionHolder := false asValue.
  1112     followFocusChannel       := false asValue.
  1113 
  1114     model := ViewTreeModel new.
  1115     model inputEventAction:[:ev| self processEvent:ev ].
  1116     model mappedViewAction:[:vw| self processMappedView:vw ].
  1117     model application:self.
  1118     model addDependent:self.
  1119 
  1120 
  1121     showNamesHolder := false asValue.
  1122     showNamesHolder addDependent:self.
  1123 !
  1124 
  1125 postBuildInspectorView:anInspector
  1126     inspectorView := anInspector.
  1127 !
  1128 
  1129 postBuildTree:aTree
  1130     treeView := aTree scrolledView.
  1131     treeView hasConstantHeight:true.
  1132 ! !
  1133 
  1134 !ViewTreeInspectorApplication methodsFor:'menu queries'!
  1135 
  1136 hasApplication
  1137     "returns true if the current selected view has an application"
  1138 
  1139     |view|
  1140 
  1141     view := self selectedView.
  1142   ^ (view notNil and:[view application notNil])
  1143 !
  1144 
  1145 hasController
  1146     "returns true if the current selected item's view has a controller
  1147      other than nil or the view itself"
  1148 
  1149     |view controller|
  1150 
  1151     view := self selectedView.
  1152 
  1153     view notNil ifTrue:[
  1154         controller := view controller.
  1155       ^ (controller notNil and:[controller ~~ view])
  1156     ].
  1157     ^ false
  1158 !
  1159 
  1160 hasModel
  1161     "returns true if the current selected view has a model"
  1162 
  1163     |view|
  1164 
  1165     view := self selectedView.
  1166   ^ (view notNil and:[view model notNil])
  1167 ! !
  1168 
  1169 !ViewTreeInspectorApplication methodsFor:'menu specs'!
  1170 
  1171 middleButtonMenu
  1172     "returns the middleButton menu for the single selected item or nil"
  1173 
  1174     ^ [ 
  1175         model selectedItem notNil 
  1176             ifTrue:[self class middleButtonMenu]
  1177             ifFalse:[nil]
  1178       ]
  1179 !
  1180 
  1181 submenuApplications:aMenu
  1182     |applications menu item list addBlock|
  1183 
  1184     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
  1185                                               ifFalse:[model rootItem].
  1186     item isNil ifTrue:[^ nil].
  1187 
  1188     applications := IdentityDictionary new.
  1189 
  1190     addBlock := [:el| |cls ctr|
  1191         cls := self resolveApplicationClassFor:el.
  1192 
  1193         cls notNil ifTrue:[
  1194             ctr := applications at:cls ifAbsent:0.
  1195             applications at:cls put:(ctr + 1).
  1196         ].
  1197     ].
  1198     item recursiveDo:addBlock.
  1199     addBlock value:item.
  1200 
  1201     applications isEmpty ifTrue:[^ nil ].
  1202     list := SortedCollection sortBlock:[:a :b| a title < b title ].
  1203 
  1204     applications keysAndValuesDo:[:cls :ctr|
  1205        list add:(MenuDesc title:(cls name)
  1206                           value:(ctr printString)
  1207                          action:[self doSelectNextOfApplicationClass:cls startingIn:item]
  1208                  ).
  1209     ].
  1210 
  1211     menu := MenuDesc buildFromList:list onGC:aMenu.
  1212     menu do:[:el|
  1213         el hideMenuOnActivated:false
  1214     ].
  1215     ^ menu
  1216 !
  1217 
  1218 submenuComponents:aMenu
  1219     |widgets list total menu item|
  1220 
  1221     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
  1222                                               ifFalse:[model rootItem].
  1223     item isNil ifTrue:[^ nil].
  1224 
  1225     widgets := IdentityDictionary new.
  1226     total   := 0.
  1227 
  1228     item recursiveDo:[:el| |cls ctr|
  1229         cls := el widget.
  1230 
  1231         cls notNil ifTrue:[
  1232             cls := cls class.
  1233             ctr := widgets at:cls ifAbsent:0.
  1234             widgets at:cls put:(ctr + 1).
  1235             total := total + 1.
  1236         ].
  1237     ].
  1238     total == 0 ifTrue:[^ nil].
  1239     list := SortedCollection sortBlock:[:a :b| a title < b title ].
  1240 
  1241     widgets keysAndValuesDo:[:cls :ctr|
  1242         list add:(MenuDesc title:(cls name)
  1243                            value:(ctr printString)
  1244                           action:[self doSelectNextOfClass:cls startingIn:item]
  1245                  ).
  1246     ].
  1247     list := list asOrderedCollection.
  1248     list add:(MenuDesc separator).
  1249     list add:(MenuDesc title:'Total' value:(total printString)).
  1250     menu := MenuDesc buildFromList:list onGC:aMenu.
  1251     menu do:[:el|
  1252         el hideMenuOnActivated:false
  1253     ].
  1254     ^ menu
  1255 !
  1256 
  1257 submenuGeometry:aMenu
  1258     "builds and returns the geometry submenu"
  1259 
  1260     |view point inst list x y|
  1261 
  1262     view := self selectedView.
  1263     view isNil ifTrue:[^ nil].
  1264 
  1265     list := OrderedCollection new.
  1266 
  1267     "/ origin
  1268     point := view relativeOrigin.
  1269     point isNil ifTrue:[ point := view origin ].
  1270 
  1271     x := view left.
  1272     y := view top.
  1273 
  1274     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1275                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1276 
  1277     list add:(MenuDesc title:'origin' value:inst).
  1278 
  1279     "/ corner
  1280     point := view relativeCorner.
  1281     point isNil ifTrue:[ point := view corner ].
  1282 
  1283     x := view right.
  1284     y := view bottom.
  1285 
  1286     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1287                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1288 
  1289     list add:(MenuDesc title:'corner' value:inst).
  1290 
  1291     "/ extent
  1292     (point := view relativeExtent) isNil ifTrue:[point := view extent].
  1293     list add:(MenuDesc title:'extent' value:point).
  1294 
  1295     "/ preferred extent
  1296     list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
  1297     list add:(MenuDesc separator).
  1298 
  1299     "/ view insets
  1300     inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
  1301                                          with:(view rightInset)
  1302                                          with:(view topInset)
  1303                                          with:(view bottomInset).
  1304 
  1305     list add:(MenuDesc title:'insets'      value:inst).
  1306     list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
  1307     list add:(MenuDesc title:'level'       value:(view level)).
  1308     list add:(MenuDesc separator).
  1309 
  1310     (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
  1311     list add:(MenuDesc title:'layout' value:inst).
  1312 
  1313     (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
  1314     list add:(MenuDesc title:'transformation' value:inst).
  1315 
  1316   ^ MenuDesc buildFromList:list onGC:aMenu
  1317 !
  1318 
  1319 submenuInspector:aMenu
  1320     "builds and returns the inspector submenu"
  1321 
  1322     |view list n names label value|
  1323 
  1324     view := self selectedView.
  1325     view isNil ifTrue:[^ nil].
  1326 
  1327     n := view class instSize.
  1328     n > 0 ifFalse:[^ nil ].
  1329 
  1330     list  := OrderedCollection new:n.
  1331     names := view class allInstVarNames.
  1332 
  1333     1 to:n do:[:i| |action|
  1334         label := (names at:i) printString.
  1335         value := view instVarAt:i.
  1336         value isNil ifTrue:[
  1337             value  := '------'.
  1338             action := nil.
  1339         ] ifFalse:[
  1340             value  := value displayString contractAtEndTo:40.
  1341             action := [(view instVarAt:i) inspect].
  1342         ].
  1343         list add:(MenuDesc title:label value:value action:action).
  1344     ].
  1345 
  1346     ^ MenuDesc buildFromList:list onGC:aMenu
  1347 !
  1348 
  1349 submenuInterface:aMenu
  1350     "builds and returns the interface submenu"
  1351 
  1352     |view label inst value list|
  1353 
  1354     view := self selectedView.
  1355     view isNil ifTrue:[^ nil].
  1356 
  1357     list := OrderedCollection new.
  1358 
  1359     inst  := view controller.
  1360     value := nil.
  1361 
  1362     inst isNil ifTrue:[
  1363         label := nil
  1364     ] ifFalse:[
  1365         inst == view ifTrue:[ 
  1366             label := '== view itself' 
  1367         ] ifFalse:[ 
  1368             label := inst displayString.
  1369             value := [view controller inspect].
  1370         ].
  1371     ].
  1372     list add:(MenuDesc title:'controller' value:label action:value).
  1373 
  1374     inst := view delegate.
  1375     inst notNil ifTrue:[
  1376         list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
  1377     ].
  1378 
  1379     inst := view application.
  1380 
  1381     inst notNil ifTrue:[ 
  1382         |topAppl|
  1383 
  1384         list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
  1385 
  1386         topAppl := inst topApplication.
  1387 
  1388         (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
  1389             list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
  1390         ].
  1391     ].
  1392     list add:(MenuDesc separator).
  1393 
  1394     (view respondsTo:#'model') ifTrue:[
  1395         inst := view model.
  1396 
  1397         inst isNil 
  1398             ifTrue:[ label := value := nil ]
  1399             ifFalse:[ label := inst displayString.
  1400                       label := label,(self aspectLabelFor:inst inApplicationOf:view).  
  1401                       value := [ view model inspect ].
  1402                     ].
  1403 
  1404         list add:(MenuDesc title:'model' value:label action:value).
  1405 
  1406         (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
  1407             view modelInterface keysAndValuesDo:[:key : val|
  1408                 val isNil ifTrue:[ label := nil ]
  1409                          ifFalse:[ label := val displayString ].
  1410 
  1411                 list add:(MenuDesc title:('      - ', key) value:label ).
  1412             ]
  1413         ].
  1414     ].
  1415 
  1416     (view respondsTo:#enableChannel) ifTrue:[
  1417         inst := view enableChannel.
  1418 
  1419         inst isNil ifTrue:[ label := value := nil ]
  1420                   ifFalse:[ label := inst displayString.
  1421                             label := label,(self aspectLabelFor:inst inApplicationOf:view).  
  1422                             value := [ view enableChannel inspect ].
  1423                           ].
  1424 
  1425         list add:(MenuDesc title:'enableChannel' value:label action:value).
  1426     ].
  1427 
  1428     #( #action #pressAction #releaseAction ) do:[:actionSelector |
  1429         (view respondsTo:actionSelector) ifTrue:[
  1430             inst := view perform:actionSelector.
  1431 
  1432             inst isNil 
  1433                 ifTrue:[ label := value := nil ]
  1434                 ifFalse:[ label := inst displayString.
  1435                             value := [ (view perform:actionSelector) inspect ].
  1436                         ].
  1437 
  1438             list add:(MenuDesc title:'action' value:label action:value).
  1439         ].
  1440     ].
  1441 
  1442     list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
  1443 
  1444     (view respondsTo:#listHolder) ifTrue:[
  1445         inst := view listHolder.
  1446 
  1447         inst isNil ifTrue:[ label := value := nil ]
  1448                   ifFalse:[ label := inst class printString.
  1449                             label := label,(self aspectLabelFor:inst inApplicationOf:view).  
  1450                             value := [ view listHolder inspect ].
  1451                           ].
  1452         list add:(MenuDesc title:'listHolder' value:label action:value).
  1453     ].
  1454 
  1455     (view respondsTo:#list) ifTrue:[
  1456         inst := view list.
  1457 
  1458         inst isNil ifTrue:[ label := value := nil ]
  1459                   ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
  1460                             label := label,(self aspectLabelFor:inst inApplicationOf:view).  
  1461                             value := [ view list inspect ].
  1462                           ].
  1463 
  1464         list add:(MenuDesc title:'list' value:label action:value).
  1465     ].
  1466 
  1467     list last isSeparator ifTrue:[ list removeLast ].
  1468     ^ MenuDesc buildFromList:list onGC:aMenu
  1469 
  1470     "Modified: / 27-04-2012 / 14:22:34 / cg"
  1471 !
  1472 
  1473 submenuVisibility:aMenu
  1474     "builds and returns the geometry submenu"
  1475 
  1476     |view list value|
  1477 
  1478     view := self selectedView.
  1479     view isNil ifTrue:[^ nil].
  1480 
  1481     list := OrderedCollection new.
  1482 
  1483     list add:(MenuDesc title:'device'     value:(view device printString)).
  1484     list add:(MenuDesc title:'drawableId' value:(view id)).
  1485     list add:(MenuDesc title:'gcId'       value:(view gcId)).
  1486 
  1487     list add:(MenuDesc separator).
  1488 
  1489     list add:(MenuDesc title:'shown'    value:(view shown)).
  1490     list add:(MenuDesc title:'realized' value:(view realized)).
  1491 
  1492     list add:(MenuDesc separator).
  1493 
  1494     list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
  1495 
  1496     (value := view visibilityChannel) isNil ifTrue:[
  1497         list add:(MenuDesc title:'visibilityChannel' value:'------').
  1498     ] ifFalse:[
  1499         list add:(MenuDesc title:'visibilityChannel'
  1500                            value:(value displayString)
  1501                           action:[view visibilityChannel inspect]).
  1502     ].
  1503 
  1504     ^ MenuDesc buildFromList:list onGC:aMenu
  1505 ! !
  1506 
  1507 !ViewTreeInspectorApplication methodsFor:'private'!
  1508 
  1509 aspectLabelFor:aModel inApplicationOf:aView
  1510     |app|
  1511 
  1512     aModel isNil ifTrue:[^ ''].
  1513     aView isNil ifTrue:[^ ''].
  1514     (app := aView application) isNil ifTrue:[^ ''].
  1515     app builder bindings keysAndValuesDo:[:aspect :value |
  1516         value == aModel ifTrue:[^ ' [aspect: ',aspect,']'].
  1517     ].
  1518     app class allInstVarNames do:[:nm | 
  1519         (app instVarNamed:nm) == aModel ifTrue:[^ ' [instvar: ',nm,']']
  1520     ].
  1521 
  1522     ^ ''
  1523 
  1524     "Created: / 27-04-2012 / 14:22:09 / cg"
  1525 !
  1526 
  1527 selectFocusView
  1528     |rootView focusView|
  1529 
  1530     rootView := model rootView.
  1531 
  1532     (rootView notNil and:[rootView shown]) ifTrue:[
  1533         focusView := rootView windowGroup focusView.
  1534     ].
  1535     focusView isNil ifTrue:[^ self ].
  1536 
  1537     self selectView:focusView
  1538 !
  1539 
  1540 selectView:aView
  1541     |currentItem viewItem|
  1542 
  1543     currentItem := model selectedItem.
  1544 
  1545     (currentItem notNil and:[currentItem widget == aView]) ifTrue:[
  1546         ^ self
  1547     ].
  1548     viewItem := model listOfItems recursiveDetect:[:el| el widget == aView ].
  1549 
  1550     viewItem notNil ifTrue:[
  1551         model selectItem:viewItem.
  1552     ].        
  1553 !
  1554 
  1555 setRootItem:aRootItemOrNil
  1556     |theProcess|
  1557 
  1558     aRootItemOrNil isNil ifTrue:[
  1559         process := nil.
  1560     ] ifFalse:[
  1561         "/ expand tree to level 3
  1562         aRootItemOrNil do:[:aRootChild|
  1563             aRootChild do:[:aSubChild| aSubChild expand ].
  1564             aRootChild expand.
  1565         ].
  1566         aRootItemOrNil expand.
  1567 
  1568         process isNil ifTrue:[
  1569             theProcess := process :=
  1570                 Process for:[   |update testModeChannel|
  1571 
  1572                                 update := false.
  1573                                 testModeChannel := model testModeChannel.
  1574 
  1575                                 [process == theProcess] whileTrue:[
  1576                                     Delay waitForSeconds:0.5.
  1577 
  1578                                     (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
  1579                                         (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
  1580                                             self selectFocusView.
  1581                                         ].
  1582                                         update ifTrue:[
  1583                                             self updateShownStatus.
  1584                                         ].
  1585                                         update := update not.
  1586                                     ].
  1587                                 ].
  1588 
  1589                              ] priority:8.
  1590             theProcess name:'ViewTreeInspector - Follow Focus'.
  1591             theProcess resume.
  1592         ].
  1593     ].
  1594     model rootItem:aRootItemOrNil.
  1595 !
  1596 
  1597 updateShownStatus
  1598     |rootItem min max visState listIdx visY0 visY1 height damage|
  1599 
  1600     rootItem := model rootItem.
  1601     (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
  1602 
  1603     max := 0.
  1604     min := 9999999.
  1605 
  1606     rootItem recursiveEachVisibleItemDo:[:anItem|
  1607         visState := (anItem widget shown).
  1608 
  1609         visState ~~ anItem isDrawnShown ifTrue:[
  1610             anItem isDrawnShown:visState.
  1611             listIdx := treeView identityIndexOf:anItem.
  1612 
  1613             listIdx > 0 ifTrue:[    
  1614                 max := max max:listIdx.
  1615                 min := min min:listIdx.
  1616             ].
  1617         ].
  1618     ].
  1619     max < min ifTrue:[^ self].
  1620     max := max + 1.
  1621 
  1622     visY0  := (treeView yVisibleOfLine:min) max:0.
  1623     visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
  1624     height := visY1 - visY0.
  1625     
  1626     height > 2 ifTrue:[
  1627         treeView shown ifTrue:[
  1628             damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
  1629             treeView invalidateDeviceRectangle:damage repairNow:false.
  1630         ].
  1631     ].
  1632 ! !
  1633 
  1634 !ViewTreeInspectorApplication methodsFor:'selection'!
  1635 
  1636 selectedView
  1637     "answer the selected view or nil"
  1638 
  1639     |item|
  1640 
  1641     item := model selectedItem.
  1642     item notNil ifTrue:[ ^ item widget ].
  1643   ^ nil
  1644 ! !
  1645 
  1646 !ViewTreeInspectorApplication methodsFor:'testing'!
  1647 
  1648 resolveApplicationClassFor:aTreeItem
  1649     aTreeItem isApplicationClass ifTrue:[
  1650        ^ aTreeItem applicationClass
  1651     ].
  1652     ^ nil
  1653 !
  1654 
  1655 selectedComponentHasChildren
  1656     |item|
  1657 
  1658     item := model selectedItem.
  1659     ^ (item notNil and:[item hasChildren])
  1660 ! !
  1661 
  1662 !ViewTreeInspectorApplication methodsFor:'user operations'!
  1663 
  1664 doBrowse:what
  1665     "open browser on:
  1666         #view           browse class
  1667         #model          browse model class
  1668         #application    browse application class
  1669         #controller     browse controller class
  1670     "
  1671     |view inst|
  1672 
  1673     view := self selectedView.
  1674     view isNil ifTrue:[^ self].
  1675 
  1676              what == #view        ifTrue:[ inst := view ]
  1677     ifFalse:[what == #model       ifTrue:[ inst := view model ]
  1678     ifFalse:[what == #application ifTrue:[ inst := view application ]
  1679     ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
  1680     ifFalse:[
  1681         ^ self
  1682     ]]]].
  1683 
  1684     inst notNil ifTrue:[
  1685         inst class browserClass openInClass:(inst class) selector:nil
  1686     ].
  1687 !
  1688 
  1689 doDestroy
  1690     "destroy the current selected view"
  1691 
  1692     |item parent|
  1693 
  1694     item := model selectedItem.
  1695     item isNil ifTrue:[ ^ self].
  1696 
  1697     parent := item parent.
  1698 
  1699     parent isNil ifTrue:[
  1700         "/ the root
  1701         model withSelectionHiddenDo:[item deleteAll].
  1702       ^ self
  1703     ].
  1704 
  1705     model withSelectionHiddenDo:[
  1706         |idx nsel|
  1707 
  1708         idx := parent identityIndexOf:item.
  1709 
  1710         idx == parent size ifTrue:[
  1711             nsel := parent at:(idx - 1) ifAbsent:parent
  1712         ] ifFalse:[
  1713             nsel := parent at:(idx + 1)
  1714         ].
  1715         model setValue:nil.
  1716         item delete.
  1717 
  1718         parent isLayoutContainer ifTrue:[
  1719             parent widget sizeChanged:nil
  1720         ].
  1721         model value:nsel.
  1722     ].
  1723 !
  1724 
  1725 doFlash
  1726     "flash the selected view"
  1727 
  1728     |view|
  1729 
  1730     view := self selectedView.
  1731     view isNil ifTrue:[ ^ self].
  1732 
  1733     view shown ifTrue:[
  1734         model withSelectionHiddenDo:[
  1735             view perform:#flash ifNotUnderstood:nil.
  1736         ].
  1737     ].
  1738 !
  1739 
  1740 doInspect:what
  1741     "open inspector on:
  1742         #view           inspect class
  1743         #group          inspect windowGroup
  1744         #model          inspect model
  1745         #application    inspect application
  1746         #controller     inspect controller
  1747     "
  1748     |inst|
  1749 
  1750     inst := self selectedView.
  1751     inst isNil ifTrue:[^ self].
  1752 
  1753              what == #group       ifTrue:[ inst := inst windowGroup ]
  1754     ifFalse:[what == #model       ifTrue:[ inst := inst model ]
  1755     ifFalse:[what == #application ifTrue:[ inst := inst application ]
  1756     ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
  1757 
  1758     inst notNil ifTrue:[ inst inspect ].
  1759 !
  1760 
  1761 doPickView
  1762     "pick a window's topView"
  1763 
  1764     |screen clickedView topWindow cursor|
  1765 
  1766     self doUnpick.
  1767 
  1768     cursor := Cursor fromImage:(self class crossHairIcon).
  1769 
  1770     screen := Screen current.
  1771     clickedView := screen viewFromPoint:(screen pointFromUserShowing:cursor).
  1772     clickedView isNil ifTrue:[^ self].
  1773 
  1774     topWindow := clickedView topView.
  1775 
  1776     (    topWindow == Screen current rootView
  1777      or:[topWindow == self window topView]
  1778     ) ifTrue:[
  1779         ^ self
  1780     ].
  1781 
  1782     model catchEvents:true.
  1783     self setRootItem:(ViewTreeItem buildViewsFrom:topWindow).
  1784     self selectView:clickedView.
  1785 !
  1786 
  1787 doRedraw
  1788     "redraw the app"
  1789 
  1790     model rootView withAllSubViewsDo:[:v | v redraw; invalidate].
  1791 !
  1792 
  1793 doSelectNextOfApplicationClass:aClass startingIn:anItem
  1794     |startItem firstFound searchNext|
  1795 
  1796     startItem  := model last.
  1797     searchNext := startItem notNil.        
  1798     firstFound := nil.
  1799 
  1800     anItem recursiveDo:[:el|
  1801         el == startItem ifTrue:[
  1802             searchNext := false
  1803         ] ifFalse:[
  1804             (self resolveApplicationClassFor:el) == aClass ifTrue:[
  1805                 searchNext ifFalse:[^ model selectItem:el].
  1806 
  1807                 firstFound isNil ifTrue:[
  1808                     firstFound := el
  1809                 ]
  1810             ]
  1811         ]
  1812     ].
  1813     firstFound notNil ifTrue:[
  1814         self window beep.
  1815         model selectItem:firstFound
  1816     ].
  1817 !
  1818 
  1819 doSelectNextOfClass:aClass startingIn:anItem
  1820     |startItem firstFound searchNext|
  1821 
  1822     startItem  := model last.
  1823     searchNext := startItem notNil.        
  1824     firstFound := nil.
  1825 
  1826     anItem recursiveDo:[:el|
  1827         el == startItem ifTrue:[
  1828             searchNext := false
  1829         ] ifFalse:[
  1830             el widget class == aClass ifTrue:[
  1831                 searchNext ifFalse:[^ model selectItem:el].
  1832 
  1833                 firstFound isNil ifTrue:[
  1834                     firstFound := el
  1835                 ]
  1836             ]
  1837         ]
  1838     ].
  1839     firstFound notNil ifTrue:[
  1840         self window beep.
  1841         model selectItem:firstFound
  1842     ].
  1843 !
  1844 
  1845 doUncatchEvents
  1846     model catchEvents:false.
  1847     self doRedraw
  1848 !
  1849 
  1850 doUnpick
  1851     "release current picked window and contained subwindows"
  1852 
  1853     self setRootItem:nil.
  1854 !
  1855 
  1856 openDocumentation
  1857     HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
  1858 ! !
  1859 
  1860 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
  1861 
  1862 buildFromList:aList onGC:aMenu
  1863     |tabSpec menu w menuPanel|
  1864 
  1865     w := 0.
  1866     aList do:[:el| w := w max:(el widthOn:aMenu) ].
  1867 
  1868     tabSpec := TabulatorSpecification new.
  1869     tabSpec unit:#pixel.
  1870     tabSpec positions:#(0     1.5 ).
  1871     tabSpec align:#(#left #left).
  1872 
  1873     w := w + 15.
  1874     tabSpec positions:(Array with:0 with:w).
  1875 
  1876     menu := Menu new.
  1877 
  1878     aList do:[:el|
  1879         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
  1880     ].
  1881     menuPanel := MenuPanel menu:menu.
  1882     ^ menuPanel
  1883 ! !
  1884 
  1885 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
  1886 
  1887 separator
  1888     ^ self new
  1889 !
  1890 
  1891 title:aTitle value:aValue
  1892     ^ self title:aTitle value:aValue action:nil
  1893 !
  1894 
  1895 title:aTitle value:aValue action:anAction
  1896     ^ self new title:aTitle value:aValue action:anAction
  1897 ! !
  1898 
  1899 !ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
  1900 
  1901 title
  1902     ^ title
  1903 ! !
  1904 
  1905 !ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
  1906 
  1907 asMenuItemWithTabulatorSpecification:aTabSpec
  1908     |array|
  1909 
  1910     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
  1911 
  1912     array := Array with:(title, ':') with:'------'.
  1913 
  1914     value notNil ifTrue:[
  1915         array at:2 put:(value printString, ' ')
  1916     ].
  1917 
  1918    ^ MenuItem 
  1919         label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
  1920         value:action
  1921 ! !
  1922 
  1923 !ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
  1924 
  1925 title:aTitle value:aValue action:anAction
  1926     "test for separator
  1927     "
  1928     title  := aTitle withoutSeparators.
  1929     action := anAction.
  1930 
  1931     aValue notNil ifTrue:[
  1932         value := aValue printString.
  1933 
  1934         value size > 70 ifTrue:[
  1935             value := value copyFrom:1 to:70.
  1936             value := value, '...'
  1937         ]
  1938     ].
  1939 ! !
  1940 
  1941 !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
  1942 
  1943 isSeparator
  1944     ^ title isNil
  1945 !
  1946 
  1947 widthOn:aGC
  1948     title isNil ifTrue:[^ 5].  "/ separator
  1949     ^ title widthOn:aGC
  1950 ! !
  1951 
  1952 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
  1953 
  1954 buildViewsFrom:aView
  1955     "build the items starting from a source view;
  1956      returns the anhor.
  1957     "
  1958     |item subViews subItems|
  1959 
  1960     aView isNil ifTrue:[^ nil].
  1961 
  1962     item     := self forView:aView.
  1963     subViews := aView subViews.
  1964 
  1965     subViews notEmptyOrNil ifTrue:[
  1966         subItems := OrderedCollection new.
  1967         subViews do:[:aSubView|
  1968             subItems add:(self buildViewsFrom:aSubView).
  1969         ].
  1970         item children:subItems.
  1971     ].
  1972     ^ item
  1973 ! !
  1974 
  1975 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
  1976 
  1977 documentation
  1978 "
  1979     ViewTreeItems represants a pickable object within a ViewTreeModel.
  1980     The class is used to build up the hierarchical tree.
  1981 
  1982     [Instance variables:]
  1983         widget        <View>            the widget represented by the item
  1984         spec          <UISpecification> the UISpecification or nil
  1985 
  1986     [Class variables:]
  1987         HandleExtent  <Point>           keeps the extent of a handle
  1988 
  1989 
  1990     [author:]
  1991         Claus Atzkern
  1992 
  1993     [see also:]
  1994         HierarchicalItem
  1995         ViewTreeModel
  1996 "
  1997 !
  1998 
  1999 version
  2000     ^ '$Header$'
  2001 ! !
  2002 
  2003 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
  2004 
  2005 initialize
  2006     "set the extent of the Handle
  2007     "
  2008     HandleExtent := 6@6.
  2009 ! !
  2010 
  2011 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
  2012 
  2013 forView:aView
  2014     |item|
  2015 
  2016     item := self basicNew initialize.
  2017     item forView:aView.
  2018   ^ item
  2019 !
  2020 
  2021 new
  2022     self error:'not allowed'.
  2023   ^ nil
  2024 !
  2025 
  2026 on:aView withSpec:aSpec
  2027     |item|
  2028 
  2029     item := self basicNew initialize.
  2030     item on:aView withSpec:aSpec.
  2031   ^ item
  2032 ! !
  2033 
  2034 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
  2035 
  2036 applicationClass
  2037     |appl|
  2038 
  2039     widget notNil ifTrue:[
  2040         appl := widget application.
  2041         appl notNil ifTrue:[^ appl class ].
  2042     ].
  2043     ^ nil
  2044 !
  2045 
  2046 isDrawnShown
  2047     "returns true if the last display operations was done during the widget was shown
  2048     "
  2049     ^ isDrawnShown
  2050 !
  2051 
  2052 isDrawnShown:aBoolean
  2053     isDrawnShown := aBoolean.
  2054 !
  2055 
  2056 rootView
  2057     "returns the widget assigned to the root or nil
  2058     "
  2059     ^ parent rootView
  2060 !
  2061 
  2062 specClass
  2063     "returns the spec-class assigned to the item
  2064     "
  2065     ^ widget specClass
  2066 !
  2067 
  2068 treeModel
  2069     "returns the assigned treeModel, an instance of ViewTreeModel
  2070     "
  2071     ^ parent treeModel
  2072 !
  2073 
  2074 widget
  2075     "returns the widget assigned to the item
  2076     "
  2077     ^ widget
  2078 ! !
  2079 
  2080 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
  2081 
  2082 boundsRelativeToRoot
  2083     "returns the bounds relative to the root widget
  2084     "
  2085     ^ self originRelativeToRoot extent:(widget extent)
  2086 !
  2087 
  2088 cornerRelativeToRoot
  2089     "returns the corner relative to the root widget
  2090     "
  2091     ^ self originRelativeToRoot + (widget extent)
  2092 !
  2093 
  2094 extent
  2095     "returns the extent of the widget
  2096     "
  2097     ^ widget extent
  2098 !
  2099 
  2100 layoutType
  2101     "returns the type of layout assigned to the wiget; nil if the
  2102      superView cannot resize its sub widgets
  2103     "
  2104     |layout specClass superView|
  2105 
  2106     (superView := widget superView) isNil ifTrue:[
  2107         ^ #Extent
  2108     ].
  2109         
  2110     specClass := superView specClass.
  2111 
  2112     (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
  2113         ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
  2114     ].
  2115 
  2116     (layout := widget geometryLayout) isNil ifTrue:[
  2117         ^ #Extent
  2118     ].
  2119 
  2120     layout isLayout ifTrue:[
  2121         layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
  2122         layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
  2123         layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
  2124     ] ifFalse:[
  2125         layout isRectangle          ifTrue:[ ^ #Rectangle ].
  2126         layout isPoint              ifTrue:[ ^ #Point ].
  2127 
  2128     ].
  2129     Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2130   ^ nil
  2131 !
  2132 
  2133 originRelativeToRoot
  2134     "returns the origin relative to the root widget
  2135     "
  2136     ^ widget originRelativeTo:(self rootView)
  2137 ! !
  2138 
  2139 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
  2140 
  2141 children
  2142     "redefined: optimize
  2143     "
  2144     ^ children
  2145 !
  2146 
  2147 hasChildren
  2148     |subViews list item|
  2149 
  2150     children size ~~ 0 ifTrue:[
  2151         ^ true
  2152     ].
  2153     isExpanded := false.
  2154     subViews   := widget subViews.
  2155 
  2156     subViews size == 0 ifTrue:[^ false].
  2157 
  2158     list := OrderedCollection new.
  2159 
  2160     subViews do:[:aSubView|
  2161         item := self class buildViewsFrom:aSubView.
  2162         item parent:self.
  2163         list add:item.
  2164     ].
  2165     children := list.
  2166     ^ true
  2167 !
  2168 
  2169 size
  2170     "redefined: returns list of children
  2171     "
  2172     ^ children size
  2173 ! !
  2174 
  2175 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
  2176 
  2177 additionalLabelForItem:anItem
  2178     "answer an additional item for an Item or nil"
  2179 
  2180     parent notNil ifTrue:[
  2181         ^ parent additionalLabelForItem:anItem
  2182     ].
  2183     ^ nil
  2184 !
  2185 
  2186 displayIcon:anIcon atX:x y:y on:aGC
  2187     |x0 y0 y1 w|
  2188 
  2189     super displayIcon:anIcon atX:x y:y on:aGC.
  2190 
  2191     self exists ifFalse:[
  2192         aGC paint:(Color red).
  2193 
  2194         y0 := y + 1.
  2195         y1 := y + anIcon height - 2.
  2196 
  2197         x0 := x - 1.
  2198         w  := anIcon width.
  2199 
  2200         2 timesRepeat:[
  2201             aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
  2202             aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
  2203             x0 := x0 + 1.
  2204         ].
  2205     ].
  2206 !
  2207 
  2208 displayOn:aGC x:x y:y h:h
  2209     |labelHeight additionalName label isValidAndShown|
  2210 
  2211     label := self label.
  2212     label isEmptyOrNil ifTrue:[^ self].
  2213 
  2214     widget id isNil ifTrue:[
  2215         isDrawnShown := false.
  2216 
  2217         self exists ifFalse:[
  2218             xOffsetAdditionalName := nil.
  2219         ].
  2220         isValidAndShown := false.
  2221     ] ifFalse:[
  2222         isValidAndShown := widget shown.
  2223     ].
  2224     isValidAndShown ifFalse:[
  2225         label := Text string:label emphasis:#italic.
  2226         label colorizeAllWith:Color grey.
  2227     ].
  2228 
  2229     labelHeight := self heightOn:aGC.
  2230     self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
  2231 
  2232     xOffsetAdditionalName notNil ifTrue:[
  2233         additionalName := self additionalLabelForItem:self.
  2234 
  2235         additionalName notNil ifTrue:[
  2236             self displayLabel:additionalName
  2237                             h:labelHeight on:aGC
  2238                             x:(x + xOffsetAdditionalName)
  2239                             y:y
  2240                             h:h.
  2241         ] ifFalse:[
  2242             xOffsetAdditionalName := nil.
  2243         ].
  2244     ].
  2245 !
  2246 
  2247 recursiveAdditionalNameBehaviourChanged
  2248     width := xOffsetAdditionalName := nil.
  2249 
  2250     children notNil ifTrue:[
  2251         children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
  2252     ].
  2253 !
  2254 
  2255 widthOn:aGC
  2256     "return the width of the receiver, if it is to be displayed on aGC
  2257     "
  2258     |additionalName|
  2259 
  2260     width isNil ifTrue:[
  2261         width := self widthOf:(self label) on:aGC.
  2262         width := width + 2.
  2263 
  2264         additionalName := self additionalLabelForItem:self.
  2265 
  2266         additionalName notNil ifTrue:[
  2267             xOffsetAdditionalName := width + 10.
  2268             width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
  2269             width := width + 2.
  2270         ] ifFalse:[
  2271             xOffsetAdditionalName := nil.
  2272         ].
  2273     ].
  2274     ^ width
  2275 ! !
  2276 
  2277 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
  2278 
  2279 handlesDo:aTwoArgAction
  2280     "evaluate the two arg block on each handle; the arguments to the block is
  2281      the rectangle relative to the rootView and the handle type which is
  2282      set to nil if not resizeable.
  2283 
  2284      TYPES:     type    position( X - Y )
  2285                 -------------------------        
  2286                 #LT     Left   - Top
  2287                 #LC     Left   - Center
  2288                 #LB     Left   - Bottom
  2289                 #CT     Center - Top
  2290                 #CB     Center - Bottom
  2291                 #RT     Right  - Top
  2292                 #RC     Right  - Center
  2293                 #RB     Right  - Bottom
  2294 
  2295                 nil     ** handle not pickable **
  2296     "
  2297     |type relOrg relCrn maxExt rootView w h
  2298      xL    "{ Class:SmallInteger }"
  2299      xC    "{ Class:SmallInteger }"
  2300      xR    "{ Class:SmallInteger }"
  2301      yT    "{ Class:SmallInteger }"
  2302      yC    "{ Class:SmallInteger }"
  2303      yB    "{ Class:SmallInteger }"
  2304     |
  2305     rootView := self rootView.
  2306     relOrg   := widget originRelativeTo:rootView.
  2307     relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
  2308 
  2309     relOrg   := relOrg - (HandleExtent // 2).
  2310     relCrn   := relOrg + widget extent.
  2311     maxExt   := rootView extent - HandleExtent.
  2312 
  2313     xL := relOrg x max:0.
  2314     xR := relCrn x min:(maxExt x).
  2315     xC := xR + xL // 2.
  2316 
  2317     yT := relOrg y max:0.
  2318     yB := relCrn y min:(maxExt y).
  2319     yC := yB + yT // 2.
  2320 
  2321     type := self layoutType.
  2322     w   := HandleExtent x.
  2323     h   := HandleExtent y.
  2324 
  2325     (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
  2326         aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
  2327         aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
  2328         aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
  2329         aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
  2330         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2331         aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
  2332         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2333         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2334       ^ self
  2335     ].
  2336 
  2337     aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
  2338     aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
  2339     aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
  2340 
  2341     type == #Extent ifTrue:[
  2342         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2343         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2344         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2345       ^ self
  2346     ].
  2347     aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
  2348 !
  2349 
  2350 recursiveEachVisibleItemDo:anOneArgBlock
  2351     "recursive evaluate the block on each child which is visible
  2352     "
  2353     (isExpanded and:[children size > 0]) ifTrue:[
  2354         children do:[:aChild|
  2355             anOneArgBlock value:aChild.
  2356             aChild recursiveEachVisibleItemDo:anOneArgBlock.
  2357         ]
  2358     ].
  2359 !
  2360 
  2361 subViewsDo:aOneArgBlock
  2362     "evaluate aBlock for all subviews other than InputView's   
  2363     "
  2364     |subViews|
  2365 
  2366     subViews := widget subViews.
  2367 
  2368     subViews notNil ifTrue:[
  2369         subViews do:aOneArgBlock
  2370     ].
  2371 ! !
  2372 
  2373 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
  2374 
  2375 forView:aView
  2376     widget := aView.
  2377 !
  2378 
  2379 initialize
  2380     "setup default attributes
  2381     "
  2382     super initialize.
  2383     isDrawnShown := false.
  2384     isExpanded   := false.
  2385     children     := OrderedCollection new.
  2386 ! !
  2387 
  2388 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
  2389 
  2390 delete
  2391     "delete self and all contained items; the assigned views are destroyed
  2392      in case of rootView, only the children are deleted
  2393     "
  2394     parent isHierarchicalItem ifTrue:[
  2395         self criticalDo:[
  2396             parent remove:self.
  2397             widget destroy.
  2398         ]
  2399     ] ifFalse:[
  2400         self deleteAll
  2401     ].
  2402 !
  2403 
  2404 deleteAll
  2405     "delete all contained items; the assigned views are destroyed
  2406     "
  2407     children size == 0 ifTrue:[^ self].
  2408 
  2409     self criticalDo:[
  2410         self nonCriticalDo:[:el| el widget destroy ].
  2411         self removeAll
  2412     ].
  2413 ! !
  2414 
  2415 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
  2416 
  2417 asLayoutFrame
  2418     "convert the layout of the widget to a LayoutFrame;
  2419     "
  2420     |extent layout newLyt lftFrc lftOff topFrc topOff|
  2421 
  2422     layout := widget geometryLayout.
  2423 
  2424     layout isNil ifTrue:[
  2425         ^ widget bounds asLayout
  2426     ].
  2427 
  2428     layout isLayout ifFalse:[
  2429         layout isRectangle ifTrue:[
  2430             ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
  2431                            topOffset:(layout top) bottomOffset:(layout bottom)
  2432         ].
  2433         layout isPoint ifTrue:[
  2434             extent := widget extent.
  2435           ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
  2436                          topOffset:(layout y) bottomOffset:(layout y + extent y)
  2437         ].
  2438 
  2439         Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2440       ^ nil
  2441     ].
  2442 
  2443     layout isLayoutFrame ifTrue:[ ^ layout copy ].    
  2444 
  2445     lftFrc := layout leftFraction.
  2446     lftOff := layout leftOffset.
  2447     topFrc := layout topFraction.
  2448     topOff := layout topOffset.
  2449     extent := widget extent.
  2450 
  2451     newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
  2452                          rightFraction:lftFrc offset:(lftOff + extent x)
  2453                            topFraction:topFrc offset:topOff
  2454                         bottomFraction:topFrc offset:(topOff + extent y).
  2455 
  2456     (      layout isAlignmentOrigin
  2457      and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
  2458     ) ifTrue:[
  2459         |svRc prBd dlta|
  2460 
  2461         svRc := widget superView viewRectangle.
  2462         prBd := widget preferredBounds.
  2463 
  2464         dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
  2465                  - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
  2466                 ) rounded.
  2467 
  2468         newLyt   leftOffset:(lftOff + dlta x).
  2469         newLyt  rightOffset:(lftOff + extent x + dlta x).
  2470         newLyt    topOffset:(topOff + dlta y).
  2471         newLyt bottomOffset:(topOff + extent y + dlta y).
  2472     ].
  2473     ^ newLyt
  2474 !
  2475 
  2476 moveLeft:l top:t
  2477     "move the widget n pixele left and right
  2478     "
  2479     |layout|
  2480 
  2481     self isMoveable ifFalse:[ ^ self ].
  2482 
  2483     (layout := widget geometryLayout) isNil ifTrue:[
  2484         "Extent"
  2485         widget origin:(widget origin + (l@t)).
  2486       ^ self
  2487     ].
  2488 
  2489     layout := layout copy.
  2490 
  2491     layout isLayout ifTrue:[
  2492         layout leftOffset:(layout leftOffset + l)
  2493                 topOffset:(layout topOffset  + t).
  2494 
  2495         layout isLayoutFrame ifTrue:[
  2496             layout  rightOffset:(layout rightOffset  + l).
  2497             layout bottomOffset:(layout bottomOffset + t).
  2498         ]
  2499 
  2500     ] ifFalse:[
  2501         layout isRectangle ifTrue:[
  2502             layout setLeft:(layout left + l).
  2503             layout  setTop:(layout top  + t).
  2504         ] ifFalse:[
  2505             layout isPoint ifFalse:[^ self].
  2506             layout x:(layout x + l) y:(layout y + t).
  2507         ]
  2508     ].
  2509     widget geometryLayout:layout.
  2510 !
  2511 
  2512 resizeLeft:l top:t right:r bottom:b
  2513     "resize the widget measured in pixels
  2514     "
  2515     |layout|
  2516 
  2517     self isResizeable ifFalse:[
  2518         ^ self
  2519     ].
  2520 
  2521     (layout := widget geometryLayout) isNil ifTrue:[
  2522         "Extent"
  2523         (r == l and:[b == t]) ifFalse:[
  2524             widget extent:(widget computeExtent + ((r-l) @ (b-t))).
  2525         ].
  2526         ^ self
  2527     ].
  2528 
  2529     layout isLayout ifTrue:[
  2530         layout := layout copy.
  2531 
  2532         layout leftOffset:(layout leftOffset + l)
  2533                 topOffset:(layout topOffset  + t).
  2534 
  2535         layout isLayoutFrame ifTrue:[
  2536             layout bottomOffset:(layout bottomOffset + b).
  2537             layout  rightOffset:(layout rightOffset  + r).
  2538         ]
  2539     ] ifFalse:[
  2540         layout isRectangle ifFalse:[^ self].
  2541         layout := layout copy.
  2542 
  2543         layout left:(layout left   + l)
  2544               right:(layout right  + r)
  2545                 top:(layout top    + t)
  2546              bottom:(layout bottom + b).
  2547     ].
  2548     widget geometryLayout:layout.
  2549 ! !
  2550 
  2551 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
  2552 
  2553 updateChildren
  2554     |list|
  2555 
  2556     self do:[:el|
  2557         el exists ifTrue:[
  2558             el updateChildren.
  2559         ] ifFalse:[
  2560             list isNil ifTrue:[list := OrderedCollection new].
  2561             list add:el.
  2562         ]
  2563     ].
  2564     list notNil ifTrue:[
  2565         list do:[:el| self remove:el ].
  2566     ].
  2567 !
  2568 
  2569 updateFromChildren:mergedList
  2570     "update my children against the list of items derived from
  2571      the merged list.
  2572     "
  2573 
  2574     mergedList size == 0 ifTrue:[ ^ self removeAll ].
  2575     children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
  2576 
  2577     self criticalDo:[
  2578         self nonCriticalDo:[:el| |wdg|
  2579             wdg := el widget.
  2580             mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
  2581         ].
  2582 
  2583         mergedList keysAndValuesDo:[:i :el| |wdg e2|
  2584             wdg := el widget.
  2585 
  2586             e2  := self at:i ifAbsent:nil.
  2587 
  2588             (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
  2589                 self add:el beforeIndex:i
  2590             ]
  2591         ]
  2592     ].
  2593 ! !
  2594 
  2595 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
  2596 
  2597 icon
  2598     "get the icon used for presentation
  2599     "
  2600     |specClass model|
  2601 
  2602     specClass := self specClass.
  2603     specClass isNil ifTrue:[^ nil].
  2604 
  2605     model := self treeModel.
  2606 
  2607     model notNil ifTrue:[
  2608         ^ model iconAt:specClass ifNonePut:[specClass icon]
  2609     ].
  2610     ^ specClass icon
  2611 !
  2612 
  2613 label
  2614     "get the label used for presentation
  2615     "
  2616     ^ self string
  2617 !
  2618 
  2619 printOn:aStream
  2620     "append a a printed representation of the item to aStream
  2621     "
  2622     aStream nextPutAll:(self string)
  2623 !
  2624 
  2625 string
  2626     "get the string
  2627     "
  2628     ^ widget class name.
  2629 ! !
  2630 
  2631 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
  2632 
  2633 canChangeLayout
  2634     "returns true if the layout of the widget can be changed and the
  2635      layout is not organized by its superView
  2636     "
  2637     ^ self isResizeable
  2638 !
  2639 
  2640 canResizeSubComponents
  2641     "returns true if the widget can resize its sub components
  2642     "
  2643     |specClass|
  2644 
  2645     specClass := self specClass.
  2646 
  2647     specClass notNil ifTrue:[
  2648         ^ specClass canResizeSubComponents
  2649     ].
  2650     ^ false
  2651 !
  2652 
  2653 exists
  2654     widget id notNil ifTrue:[^ true ].
  2655 
  2656     exists ~~ false ifTrue:[
  2657         exists := false.
  2658 
  2659         widget superView notNil ifTrue:[
  2660             (parent isHierarchicalItem and:[parent exists]) ifTrue:[
  2661                 exists := (parent widget subViews includesIdentical:widget).
  2662             ].
  2663         ].
  2664     ].
  2665     ^ exists
  2666 !
  2667 
  2668 isApplicationClass
  2669     |cls|
  2670 
  2671     cls := widget class.
  2672 
  2673     ^ (    cls == ApplicationSubView
  2674         or:[cls == ApplicationWindow
  2675         or:[cls == SubCanvas]]
  2676       ) 
  2677 !
  2678 
  2679 isSelected
  2680     |model|
  2681 
  2682     model := self treeModel.
  2683     model notNil ifTrue:[^ model isSelected:self].
  2684     ^ false
  2685 !
  2686 
  2687 supportsSubComponents
  2688     "returns true if the widget supports sub components
  2689     "
  2690     |specClass|
  2691 
  2692     widget isScrollWrapper ifTrue:[
  2693         ^ false
  2694     ].
  2695     specClass := self specClass.
  2696 
  2697     specClass notNil ifTrue:[
  2698         ^ specClass supportsSubComponents
  2699     ].
  2700     ^ false
  2701 ! !
  2702 
  2703 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
  2704 
  2705 isInLayoutContainer
  2706     "returns true if the widget is in a layout container
  2707     "
  2708     |sv specClass|
  2709 
  2710     sv := widget superView.
  2711 
  2712     sv notNil ifTrue:[
  2713         specClass := sv specClass.
  2714 
  2715         specClass notNil ifTrue:[
  2716             ^ specClass isLayoutContainer
  2717         ].
  2718     ].
  2719     ^ false
  2720 !
  2721 
  2722 isLayoutContainer
  2723     "answer whether corresponding view instances of the spec class can contain
  2724      (and arrange) other view
  2725     "
  2726     |specClass|
  2727 
  2728     specClass := self specClass.
  2729 
  2730     specClass notNil ifTrue:[
  2731         ^ specClass isLayoutContainer
  2732     ].
  2733     ^ false
  2734 !
  2735 
  2736 isMoveable
  2737     "returns true if the widget is not in a layout container
  2738     "
  2739     self isInLayoutContainer ifFalse:[
  2740         ^ widget superView notNil
  2741     ].
  2742     ^ false
  2743 !
  2744 
  2745 isResizeable
  2746     "returns true if the widget is resizeable
  2747     "
  2748     |sv specClass|
  2749 
  2750     sv := widget superView.
  2751 
  2752     sv notNil ifTrue:[
  2753         specClass := sv specClass.
  2754 
  2755         specClass notNil ifTrue:[
  2756             ^ specClass canResizeSubComponents
  2757         ].
  2758     ].
  2759     ^ false
  2760 ! !
  2761 
  2762 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
  2763 
  2764 documentation
  2765 "
  2766     Instances of ViewTreeModel can be used as model on a View and all
  2767     it contained subviews for a HierarchicalListView.
  2768     The model keeps two values, the hierarchical representation of the views
  2769     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
  2770     It shows the selected items highlighted.
  2771 
  2772 
  2773     [Instance variables:]
  2774         lockSema            <Semaphore>         lock selection notifications and redraws
  2775 
  2776         testModeChannel     <ValueHolder>       true, than running in test mode.
  2777 
  2778         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
  2779 
  2780         selection           <Sequence or nil>   selected items or nil
  2781 
  2782         hiddenLevel         <Integer>           internal use; redrawing the selection
  2783                                                 only is done if the counter is 0.
  2784 
  2785         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
  2786 
  2787         selectedSuperItems  <Sequence>          list of selected super items; items selected
  2788                                                 but not contained in another selected item.
  2789 
  2790         inputEventAction    <Action>            called for each InputEvent
  2791 
  2792         mappedViewAction    <Action>            called for a new mapped view which
  2793                                                 can not be found in the current item list.
  2794 
  2795         beforeSelectionChangedAction <Action>   called before the selection changed
  2796 
  2797     [author:]
  2798         Claus Atzkern
  2799 
  2800     [see also:]
  2801         ViewTreeItem
  2802 "
  2803 !
  2804 
  2805 examples
  2806 "
  2807     example 1: pick any window and show views and contained views
  2808                                                                                 [exBegin]
  2809     |top sel model panel|
  2810 
  2811     model := ViewTreeModel new.
  2812     top   := StandardSystemView new; extent:440@400.
  2813     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
  2814     sel bottomInset:24.
  2815 
  2816     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
  2817     panel topInset:-24.
  2818     panel horizontalLayout:#fitSpace.
  2819 
  2820     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
  2821     Button label:'Pick Views' action:[  |win|
  2822                                         (     (win := Screen current viewFromUser) notNil
  2823                                          and:[(win := win topView) ~~ Screen current rootView
  2824                                          and:[win ~~ top]]
  2825                                         ) ifTrue:[
  2826                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
  2827                                         ] ifFalse:[
  2828                                             model rootItem:nil
  2829                                         ]
  2830                                      ] in:panel.
  2831 
  2832     sel  multipleSelectOk:true.
  2833     sel              list:model listOfItems.
  2834     sel             model:model.
  2835     sel          useIndex:false.
  2836 
  2837     sel doubleClickAction:[:i| |el|
  2838         el := model listOfItems at:i.
  2839         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
  2840     ].
  2841     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
  2842 
  2843     model inputEventAction:[:anEvent| |item|
  2844         anEvent isButtonEvent ifTrue:[
  2845             anEvent isButtonPressEvent ifTrue:[
  2846                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
  2847             ] ifFalse:[
  2848                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  2849                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
  2850                 ]
  2851             ]
  2852         ]
  2853     ].
  2854 
  2855     top openAndWait.
  2856     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
  2857 
  2858                                                                                 [exEnd]
  2859 "
  2860 ! !
  2861 
  2862 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
  2863 
  2864 application:anApplication
  2865     listOfItems application:anApplication.
  2866 !
  2867 
  2868 catchEvents:aBoolean
  2869     catchEvents := aBoolean.
  2870     aBoolean ifFalse:[
  2871         self redrawUnselected:selection andLock:false checkTestMode:false.
  2872     ].
  2873 !
  2874 
  2875 rootItem
  2876     "get the rootItem the event viewer is established on
  2877     "
  2878     ^ listOfItems root
  2879 !
  2880 
  2881 rootItem:anItem
  2882     "set the rootItem the event viewer is established on
  2883     "
  2884     |expanded|
  2885 
  2886     timedUpdateTask := nil.
  2887     self deselect.
  2888 
  2889     lockSema critical:[
  2890         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
  2891                      ifFalse:[ expanded := false ].
  2892 
  2893         self value:nil.
  2894         listOfItems root:anItem.
  2895 
  2896         anItem notNil ifTrue:[
  2897             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
  2898             timedUpdateTask name:'Update'.
  2899             timedUpdateTask resume.
  2900         ].
  2901     ].
  2902 
  2903     (expanded and:[anItem notNil]) ifTrue:[
  2904         anItem expand
  2905     ].
  2906     ^ anItem
  2907 !
  2908 
  2909 rootView
  2910     "get the top widget the event viewer is established on, a View
  2911     "
  2912     ^ listOfItems rootView
  2913 ! !
  2914 
  2915 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
  2916 
  2917 beforeSelectionChangedAction
  2918     "none argument action which is called before
  2919      the selection changed
  2920     "
  2921     ^ beforeSelectionChangedAction
  2922 !
  2923 
  2924 beforeSelectionChangedAction:aNoneArgBlock
  2925     "none argument action which is called before
  2926      the selection changed
  2927     "
  2928     beforeSelectionChangedAction := aNoneArgBlock.
  2929 !
  2930 
  2931 inputEventAction
  2932     "called for each input event; the argument to the action is the WindowEvent
  2933     "
  2934     ^ inputEventAction
  2935 !
  2936 
  2937 inputEventAction:aOneArgActionTheEvent
  2938     "called for each input event; the argument to the action is the WindowEvent
  2939     "
  2940     inputEventAction := aOneArgActionTheEvent.
  2941 !
  2942 
  2943 mappedViewAction
  2944     "called for a new mapped view which can not be found
  2945      in the current item list
  2946     "
  2947     ^ mappedViewAction
  2948 !
  2949 
  2950 mappedViewAction:aOneArgBlockTheMappedView
  2951     "called for a new mapped view which can not be found
  2952      in the current item list
  2953     "
  2954     mappedViewAction := aOneArgBlockTheMappedView
  2955 ! !
  2956 
  2957 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
  2958 
  2959 iconAt:aKey ifNonePut:aNoneArgBlock
  2960     |icon view|
  2961 
  2962     icon := icons at:aKey ifAbsent:nil.
  2963     icon notNil ifTrue:[^ icon].
  2964 
  2965     icon := aNoneArgBlock value.
  2966     icon isNil ifTrue:[^ nil].
  2967 
  2968     view := self rootView.
  2969     view isNil ifTrue:[^ icon].
  2970 
  2971     icon := icon copy onDevice:(view device).
  2972     icon isImage ifTrue:[
  2973         icon clearMaskedPixels.
  2974     ].
  2975     icons at:aKey put:icon.
  2976     ^ icon
  2977 ! !
  2978 
  2979 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
  2980 
  2981 signalHiddenLevel
  2982     "show the selection if signaled; increments hiddenLevel
  2983      see: #waitHiddenLevel
  2984     "
  2985     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
  2986         hiddenLevel := 0.
  2987         self invalidateSelection.
  2988     ].
  2989 !
  2990 
  2991 waitHiddenLevel
  2992     "hide the selection until signaled; increments hiddenLevel
  2993      see: #signalHiddenLevel
  2994     "
  2995     self redrawUnselected:selection andLock:true
  2996 !
  2997 
  2998 withSelectionHiddenDo:aNoneArgumentBlock
  2999     "apply block with selection hidden
  3000     "
  3001 
  3002     [   self waitHiddenLevel.
  3003 
  3004         aNoneArgumentBlock value
  3005 
  3006     ] valueNowOrOnUnwindDo:[
  3007         self signalHiddenLevel.
  3008     ].
  3009 ! !
  3010 
  3011 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
  3012 
  3013 hasTargetWidgetChannel
  3014     "answer the channel which is set to true if a target widget exists"
  3015 
  3016     ^ hasTargetWidgetChannel
  3017 !
  3018 
  3019 listOfItems
  3020     "hiearchical list build from existing items"
  3021 
  3022     ^ listOfItems
  3023 !
  3024 
  3025 selectOnClickHolder
  3026     "boolean holder, which indicates whether the selection will change on click
  3027     "
  3028     ^ selectOnClickHolder
  3029 !
  3030 
  3031 testModeChannel
  3032     "answer a boolean channel which describes the behaviour how to process
  3033      events on the target view.
  3034 
  3035      false: all input events are eaten and the selection is shown on the target view.
  3036      true:  no  input events are eaten and no  selection is shown on the target view."
  3037 
  3038     ^ testModeChannel
  3039 ! !
  3040 
  3041 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
  3042 
  3043 targetWidgetChanged
  3044     hasTargetWidgetChannel value:(self rootItem notNil).
  3045 !
  3046 
  3047 timedUpdateTaskCycle
  3048     |view myTaskId|
  3049 
  3050     myTaskId := timedUpdateTask.
  3051 
  3052     listOfItems root notNil ifTrue:[
  3053         view := listOfItems root widget.
  3054     ].
  3055 
  3056     [ view notNil ] whileTrue:[
  3057         Delay waitForSeconds:0.5.
  3058         
  3059         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
  3060             view := nil.
  3061         ] ifTrue:[
  3062             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
  3063                 view sensor pushUserEvent:#updateChildren for:self.
  3064             ].
  3065         ].
  3066     ].
  3067     timedUpdateTask == myTaskId ifTrue:[
  3068         timedUpdateTask := nil.
  3069         listOfItems root:nil.
  3070     ].
  3071 !
  3072 
  3073 update:something with:someArgument from:aModel
  3074 
  3075     aModel == testModeChannel ifTrue:[
  3076         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
  3077             testModeChannel value ifTrue:[
  3078                 self redrawUnselected:selection andLock:false checkTestMode:false.
  3079             ] ifFalse:[
  3080                 self invalidateSelection.
  3081             ].
  3082         ].
  3083         ^ self
  3084     ].
  3085     super update:something with:someArgument from:aModel.
  3086 !
  3087 
  3088 updateChildren
  3089     |rootItem|
  3090 
  3091     rootItem := listOfItems root.
  3092     rootItem isNil ifTrue:[^ self].
  3093 
  3094     rootItem exists ifFalse:[
  3095         listOfItems root:nil.
  3096     ] ifTrue:[
  3097         rootItem updateChildren.
  3098     ].
  3099 ! !
  3100 
  3101 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
  3102 
  3103 processEvent:anEvent
  3104     "catch and process all WindowEvents for the rootComponent and its contained
  3105      widgets; redraw selection in case of damage...
  3106      return true, if the event was eaten"
  3107 
  3108     |evView item rootView testMode|
  3109 
  3110     catchEvents ifFalse:[^ false].
  3111 
  3112     evView := anEvent view.
  3113     evView isNil ifTrue:[
  3114         (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
  3115             ^ false
  3116         ].
  3117         anEvent value.
  3118         ^ true.
  3119     ].
  3120     rootView := listOfItems rootView.
  3121     rootView isNil ifTrue:[ ^ false ].
  3122 
  3123     anEvent isConfigureEvent ifTrue:[
  3124         hiddenLevel == 0 ifTrue:[
  3125             self redrawUnselected:selection andLock:false.
  3126         ].
  3127         ^ false
  3128     ].
  3129 
  3130     "/ check whether view is contained within the rootView
  3131     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
  3132         ^ false
  3133     ].
  3134 
  3135     anEvent isInputEvent ifFalse:[
  3136         anEvent isDamage ifTrue:[
  3137             hiddenLevel == 0 ifTrue:[self invalidateSelection].
  3138             ^ false
  3139         ].
  3140 
  3141         anEvent isMapEvent ifTrue:[
  3142             mappedViewAction notNil ifTrue:[
  3143                 item := listOfItems recursiveDetect:[:el| el widget == evView].
  3144                 item isNil ifTrue:[ mappedViewAction value:evView ]
  3145             ].
  3146             ^ false
  3147         ].
  3148 
  3149         anEvent type == #terminate ifTrue:[
  3150             item := listOfItems recursiveDetect:[:el| el widget == evView].
  3151             item notNil ifTrue:[ self processTerminateForItem:item ].
  3152             ^ false
  3153         ].
  3154         ^ false
  3155     ].
  3156     testMode := testModeChannel value.
  3157 
  3158     anEvent isFocusEvent ifTrue:[
  3159         evView == rootView ifTrue:[
  3160             self invalidateSelection
  3161         ].
  3162         ^ testMode not.
  3163     ].
  3164     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
  3165 
  3166     testMode ifFalse:[
  3167         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
  3168     ] ifTrue:[
  3169         anEvent isButtonPressEvent ifTrue:[
  3170             selectOnClickHolder value ifTrue:[
  3171                 self selectItem:(listOfItems detectItemRespondsToView:evView).
  3172             ].
  3173         ]
  3174     ].
  3175 
  3176     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
  3177         hiddenLevel := 1.
  3178         self signalHiddenLevel.
  3179     ].
  3180 
  3181     ^ testMode not
  3182 !
  3183 
  3184 processTerminateForItem:anItem
  3185     "received terminate for an item
  3186     "
  3187     anItem remove.
  3188 ! !
  3189 
  3190 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
  3191 
  3192 initialize
  3193     "setup the default attributes
  3194     "
  3195     super initialize.
  3196 
  3197     hiddenLevel           := 0.
  3198     lockSema              := RecursionLock new.
  3199     listOfItems           := ItemList new on:self.
  3200     selectedSuperItems    := #().
  3201     icons                 := IdentityDictionary new.
  3202     catchEvents           := true.
  3203 
  3204     hasTargetWidgetChannel := false asValue.
  3205     selectOnClickHolder    := true asValue.
  3206 
  3207     testModeChannel := false asValue.
  3208     testModeChannel addDependent:self.
  3209 ! !
  3210 
  3211 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
  3212 
  3213 invalidateSelection
  3214     "invalidate the current selection
  3215     "
  3216     |topView|
  3217 
  3218     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3219 
  3220     (     hiddenLevel == 0
  3221      and:[selection notNil
  3222      and:[(topView := listOfItems rootView) notNil
  3223      and:[topView shown]]]
  3224     ) ifTrue:[
  3225         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
  3226     ]
  3227 !
  3228 
  3229 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
  3230     "repair all views and contained views, which intersects the damage.
  3231      !!!! all damages repaired are removed from the list of damages !!!!
  3232     "
  3233     |color relOrg damage subViews repaired
  3234      bwWidth    "{ Class:SmallInteger }"
  3235      x          "{ Class:SmallInteger }"
  3236      y          "{ Class:SmallInteger }"
  3237      w          "{ Class:SmallInteger }"
  3238      h          "{ Class:SmallInteger }"
  3239      relOrgX    "{ Class:SmallInteger }"
  3240      relOrgY    "{ Class:SmallInteger }"
  3241      width      "{ Class:SmallInteger }"
  3242      height     "{ Class:SmallInteger }"
  3243      size       "{ Class:SmallInteger }"
  3244     |
  3245     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
  3246 
  3247     subViews := aView subViews.
  3248 
  3249     subViews size ~~ 0 ifTrue:[
  3250         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
  3251         theDamages isEmpty ifTrue:[ ^ self ].
  3252     ].
  3253 
  3254     relOrg  := aView originRelativeTo:aRootView.
  3255     bwWidth := aView borderWidth.
  3256     size    := theDamages size.
  3257 
  3258     "/ compute relative origin starting from border left@top
  3259     relOrgX := relOrg x - bwWidth.
  3260     relOrgY := relOrg y - bwWidth.
  3261     width   := aView width  + bwWidth + bwWidth.
  3262     height  := aView height + bwWidth + bwWidth.
  3263 
  3264     size to:1 by:-1 do:[:anIndex|
  3265         repaired := damage := theDamages at:anIndex.
  3266 
  3267         "/ compute the rectangle into the view
  3268         y := damage top  - relOrgY.
  3269         x := damage left - relOrgX.
  3270         w := damage width.
  3271         h := damage height.
  3272 
  3273         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
  3274         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
  3275         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
  3276         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
  3277 
  3278         (w > 0 and:[h > 0]) ifTrue:[
  3279             bwWidth ~~ 0 ifTrue:[
  3280                 color isNil ifTrue:[
  3281                     "/ must force redraw of border
  3282                     color := aView borderColor.
  3283                     aView borderColor:(Color colorId:1).
  3284                     aView borderColor:color.
  3285                 ].
  3286                 w := w - bwWidth.
  3287                 h := h - bwWidth.
  3288 
  3289                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
  3290                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
  3291 
  3292                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
  3293             ].
  3294 
  3295             w > 0 ifTrue:[
  3296                 aView clearRectangleX:x y:y width:w height:h.
  3297                 aView exposeX:x y:y width:w height:h
  3298             ].
  3299             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
  3300         ]
  3301     ].
  3302 !
  3303 
  3304 redrawSelection
  3305     "redraw all items selected
  3306     "
  3307     |topView size|
  3308 
  3309     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3310 
  3311     (     hiddenLevel == 0
  3312      and:[(size := selection size) > 0
  3313      and:[(topView := listOfItems rootView) notNil
  3314      and:[topView shown
  3315      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
  3316     ) ifFalse:[
  3317         ^ self
  3318     ].
  3319 
  3320     lockSema critical:[
  3321         |list|
  3322 
  3323         list := selection.
  3324 
  3325         list size > 0 ifTrue:[
  3326             topView paint:(Color black).
  3327             topView clippedByChildren:false.
  3328 
  3329             list keysAndValuesReverseDo:[:anIndex :anItem|
  3330                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
  3331 
  3332                 anItem handlesDo:[:aRect :what|
  3333                     what isNil ifTrue:[topView displayRectangle:aRect]
  3334                               ifFalse:[topView    fillRectangle:aRect]
  3335                 ]
  3336             ].
  3337             topView clippedByChildren:true.
  3338         ].
  3339     ].
  3340 !
  3341 
  3342 redrawUnselected:aList andLock:doLock
  3343     "redraw all items unselected; if doLock is true, the hiddenLevel
  3344      is incremented and thus the select mechanism is locked.
  3345     "
  3346     self redrawUnselected:aList andLock:doLock checkTestMode:true.
  3347 !
  3348 
  3349 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
  3350     "redraw all items unselected; if doLock is true, the hiddenLevel
  3351      is incremented and thus the select mechanism is locked.
  3352     "
  3353     |rootView damages subViews x y w h|
  3354 
  3355     doLock ifTrue:[
  3356         hiddenLevel := hiddenLevel + 1.
  3357         hiddenLevel ~~ 1 ifTrue:[^ self].
  3358     ] ifFalse:[
  3359         hiddenLevel ~~ 0 ifTrue:[^ self].
  3360     ].
  3361     checkTestMode ifTrue:[
  3362         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3363     ].
  3364 
  3365     (     aList size ~~ 0
  3366      and:[(rootView := listOfItems rootView) notNil
  3367      and:[rootView shown]]
  3368     ) ifFalse:[
  3369         ^ self
  3370     ].
  3371 
  3372     lockSema critical:[
  3373         damages := OrderedCollection new:(8 * aList size).
  3374 
  3375         aList do:[:item|
  3376             item handlesDo:[:handle :what|
  3377                 damages reverseDo:[:el|
  3378                     (el intersects:handle) ifTrue:[
  3379                         damages removeIdentical:el.
  3380 
  3381                         handle left:(handle left   min:el left)
  3382                               right:(handle right  max:el right)
  3383                                 top:(handle top    min:el top)
  3384                              bottom:(handle bottom max:el bottom)
  3385                     ]
  3386                 ].                        
  3387                 damages add:handle
  3388             ]
  3389         ].
  3390 
  3391         damages do:[:el|
  3392             x := el left.
  3393             y := el top.
  3394             w := el width.
  3395             h := el height.
  3396 
  3397             rootView clearRectangleX:x y:y width:w height:h.
  3398             rootView         exposeX:x y:y width:w height:h.
  3399         ].
  3400 
  3401         (subViews := rootView subViews) notNil ifTrue:[
  3402             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
  3403         ].
  3404     ].
  3405 ! !
  3406 
  3407 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
  3408 
  3409 isInTestMode
  3410     "answer false, all input events are eaten and the selection is shown on the target view.
  3411      answer true,  no  input events are eaten and no  selection is shown on the target view."
  3412 
  3413     ^ testModeChannel value
  3414 ! !
  3415 
  3416 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
  3417 
  3418 at:anIndex
  3419     "returns the selected item at an index or nil
  3420     "
  3421     selection notNil ifTrue:[
  3422         ^ selection at:anIndex ifAbsent:nil
  3423     ].
  3424     ^ nil
  3425 !
  3426 
  3427 at:anIndex ifAbsent:aBlock
  3428     "returns the selected item at an index or the result of the block
  3429     "
  3430     selection notNil ifTrue:[
  3431         ^ selection at:anIndex ifAbsent:aBlock
  3432     ].
  3433     ^ aBlock value
  3434 !
  3435 
  3436 first
  3437     "returns the first selected item or nil
  3438     "
  3439     ^ self at:1
  3440 !
  3441 
  3442 last
  3443     "returns the last selected item or nil
  3444     "
  3445     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
  3446 !
  3447 
  3448 selectedItem
  3449     "returns the single selected item or nil (size ~~ 1 nil is returned)
  3450     "
  3451     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
  3452 !
  3453 
  3454 selectedSuperItems
  3455     "returs the list of selected superItems; items selected
  3456      but not contained in another selected item.
  3457     "
  3458     ^ selectedSuperItems
  3459 !
  3460 
  3461 size
  3462     "returns the number of items selected
  3463     "
  3464     ^ selection size
  3465 ! !
  3466 
  3467 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
  3468 
  3469 add:item
  3470     "add an item to the current selection
  3471     "
  3472     |newSelect|
  3473 
  3474     item isNil ifTrue:[^ item].
  3475 
  3476     lockSema critical:[
  3477         selection isNil ifTrue:[
  3478             newSelect := Array with:item.
  3479         ] ifFalse:[
  3480             (self includes:item) ifFalse:[
  3481                 newSelect := selection copyWith:item
  3482             ]
  3483         ].
  3484 
  3485         newSelect size ~~ selection size ifTrue:[
  3486             item makeVisible.
  3487             self value:newSelect
  3488         ]
  3489     ].
  3490     ^ item
  3491 !
  3492 
  3493 addAll:aCollectionOfItems
  3494     "add a collection of items to the current selection
  3495     "
  3496     |newSelect|
  3497 
  3498     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
  3499 
  3500     lockSema critical:[
  3501         selection isNil ifTrue:[
  3502             newSelect := Array withAll:aCollectionOfItems.
  3503         ] ifFalse:[
  3504             newSelect := OrderedCollection withAll:selection.
  3505 
  3506             aCollectionOfItems do:[:el|
  3507                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
  3508             ].
  3509         ].
  3510         self value:newSelect.
  3511     ].
  3512     ^ aCollectionOfItems
  3513 !
  3514 
  3515 deselect
  3516     "clear the selection
  3517     "
  3518     self value:nil.
  3519 !
  3520 
  3521 remove:item
  3522     "remove the item from the current selection
  3523     "
  3524     |newSelect|
  3525 
  3526     item isNil ifTrue:[^ nil].
  3527 
  3528     lockSema critical:[
  3529         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
  3530             selection size == 1 ifTrue:[ newSelect := nil ]
  3531                                ifFalse:[ newSelect := selection copyWithout:item ].
  3532 
  3533             self value:newSelect
  3534         ].
  3535     ].
  3536     ^ item
  3537 !
  3538 
  3539 removeAll
  3540     "clear the selection
  3541     "
  3542     self deselect.
  3543 !
  3544 
  3545 removeAll:loItems
  3546     "remove all items of the collection from the current selection
  3547     "
  3548     |newSelect|
  3549 
  3550     selection   isNil ifTrue:[ ^ loItems ].
  3551     loItems size == 0 ifTrue:[ ^ loItems ].
  3552 
  3553     lockSema critical:[
  3554         selection notNil ifTrue:[
  3555             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
  3556             self value:newSelect.
  3557         ]
  3558     ].
  3559     ^ loItems
  3560 !
  3561 
  3562 selectAll
  3563     "select all items
  3564     "
  3565     |root newSelection|
  3566 
  3567     root := listOfItems root.
  3568 
  3569     root isNil ifTrue:[
  3570         newSelection := nil
  3571     ] ifFalse:[
  3572         newSelection := OrderedCollection new.
  3573         root recursiveDo:[:el| newSelection add:el ].
  3574     ].
  3575     self value:newSelection.
  3576 !
  3577 
  3578 selectItem:anItem
  3579     "set the current selection to the item
  3580     "
  3581     self value:anItem
  3582 !
  3583 
  3584 selectRootItem
  3585     "set the current selection to the root item
  3586     "
  3587     self value:(self rootItem).
  3588 !
  3589 
  3590 selectedItem:anItem
  3591     "set the current selection to the item
  3592     "
  3593     self selectItem:anItem.
  3594 !
  3595 
  3596 toggleSelectItem:anItem
  3597     "toggle selection-state of the item; add or remove the item from the
  3598      current selection.
  3599     "
  3600     anItem notNil ifTrue:[
  3601         (self includes:anItem) ifTrue:[self remove:anItem]
  3602                               ifFalse:[self add:anItem]
  3603     ].
  3604     ^ anItem
  3605 ! !
  3606 
  3607 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
  3608 
  3609 collect:aBlock
  3610     "for each element in the selection, evaluate the argument, aBlock
  3611      and return a new collection with the results
  3612     "
  3613     |res|
  3614 
  3615     res := OrderedCollection new.
  3616     self do:[:el| res add:(aBlock value:el)].
  3617   ^ res
  3618 !
  3619 
  3620 do:aOneArgBlock
  3621     "evaluate the argument, aBlock for each item in the selection
  3622     "
  3623     |cashedSelection|
  3624 
  3625     cashedSelection := selection.
  3626     cashedSelection isNil ifTrue:[^ nil].
  3627   ^ cashedSelection do:aOneArgBlock
  3628 !
  3629 
  3630 from:start do:aOneArgBlock
  3631     "evaluate the argument, aBlock for the items starting at index start
  3632     "
  3633     |cashedSelection|
  3634 
  3635     cashedSelection := selection.
  3636     cashedSelection isNil ifTrue:[^ nil].
  3637   ^ cashedSelection from:start do:aOneArgBlock
  3638 !
  3639 
  3640 from:start to:stop do:aOneArgBlock
  3641     "evaluate the argument, aBlock for the items with index start to
  3642      stop in the selection.
  3643     "
  3644     |cashedSelection|
  3645 
  3646     cashedSelection := selection.
  3647     cashedSelection isNil ifTrue:[^ nil].
  3648   ^ cashedSelection from:start to:stop do:aOneArgBlock
  3649 !
  3650 
  3651 reverseDo:aOneArgBlock
  3652     "evaluate the argument, aBlock for each item in the selection
  3653     "
  3654     |cashedSelection|
  3655 
  3656     cashedSelection := selection.
  3657     cashedSelection isNil ifTrue:[^ nil].
  3658   ^ cashedSelection reverseDo:aOneArgBlock
  3659 !
  3660 
  3661 select:aBlock
  3662     "return a new collection with all elements from the selection, for which
  3663      the argument aBlock evaluates to true.
  3664     "
  3665     |res|
  3666 
  3667     res := OrderedCollection new.
  3668     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
  3669   ^ res
  3670 ! !
  3671 
  3672 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
  3673 
  3674 changed:aParameter with:oldSelection
  3675     "update the visibility staus of the current selection
  3676     "
  3677     |unselected rootView rootItem selSize|
  3678 
  3679     selSize := selection size.
  3680 
  3681     selSize == 0 ifTrue:[
  3682         selectedSuperItems := #().
  3683     ] ifFalse:[
  3684         selSize == 1 ifTrue:[
  3685             selectedSuperItems := Array with:(selection at:1).
  3686         ] ifFalse:[
  3687             rootItem := listOfItems root.
  3688 
  3689             (selection includesIdentical:rootItem) ifTrue:[
  3690                 selectedSuperItems := Array with:rootItem.
  3691             ] ifFalse:[
  3692                 selectedSuperItems := OrderedCollection new:selSize.
  3693 
  3694                 selection do:[:anItem|
  3695                     anItem parentsDetect:[:el| selection includesIdentical:el ]
  3696                                   ifNone:[ selectedSuperItems add:anItem ].
  3697                 ].
  3698             ]
  3699         ]
  3700     ].
  3701 
  3702     (     hiddenLevel == 0
  3703      and:[(rootView := listOfItems rootView) notNil
  3704      and:[rootView shown]]
  3705     ) ifTrue:[
  3706         selSize == 0 ifTrue:[
  3707             "/ must redraw the old selection unselected
  3708             self redrawUnselected:oldSelection andLock:false
  3709         ] ifFalse:[
  3710             self invalidateSelection.
  3711 
  3712             oldSelection size ~~ 0 ifTrue:[
  3713                 "/ must redraw all elements no longer in the selection
  3714                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
  3715                 self redrawUnselected:unselected andLock:false.
  3716             ]
  3717         ]
  3718     ].
  3719     super changed:aParameter with:oldSelection.
  3720 !
  3721 
  3722 setValue:aNewSelection 
  3723     "set the selection without notifying
  3724     "
  3725     |newSelect idx|
  3726 
  3727     newSelect := nil.
  3728 
  3729     aNewSelection notNil ifTrue:[
  3730         lockSema critical:[
  3731             aNewSelection isCollection ifFalse:[
  3732                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
  3733                     newSelect := selection
  3734                 ] ifFalse:[
  3735                     newSelect := Array with:aNewSelection.
  3736                 ]
  3737             ] ifTrue:[
  3738                 aNewSelection notEmpty ifTrue:[
  3739                     aNewSelection size ~~ selection size ifTrue:[
  3740                         newSelect := aNewSelection copy.
  3741                     ] ifFalse:[
  3742                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
  3743 
  3744                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
  3745                                 ifFalse:[newSelect := selection ].
  3746                     ]
  3747                 ]
  3748             ]
  3749         ].
  3750     ].
  3751     newSelect ~~ selection ifTrue:[
  3752         beforeSelectionChangedAction value.
  3753         selection := newSelect.
  3754         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  3755     ].
  3756 !
  3757 
  3758 triggerValue:aValue
  3759     "set my value & send change notifications to my dependents.
  3760      Send the change message even if the value didn't change.
  3761     "
  3762     |oldSelection|
  3763 
  3764     lockSema critical:[
  3765         oldSelection := selection.
  3766         self setValue:aValue.
  3767         self changed:#value with:oldSelection
  3768     ]
  3769 !
  3770 
  3771 value
  3772     "returns the current selection
  3773     "
  3774     ^ selection ? #()
  3775 !
  3776 
  3777 value:aValue
  3778     "change the current selection and send change notifications to my
  3779      dependents if it changed.
  3780     "
  3781     |oldSelection|
  3782 
  3783     lockSema critical:[
  3784         oldSelection := selection.
  3785         self setValue:aValue.
  3786 
  3787         oldSelection == selection ifFalse:[
  3788             self changed:#value with:oldSelection
  3789         ]
  3790     ].
  3791 ! !
  3792 
  3793 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
  3794 
  3795 detect:aBlock
  3796     "evaluate the argument, aBlock for each item in the selection until
  3797      the block returns true; in this case return the element which caused
  3798      the true evaluation.
  3799      If none of the evaluations returns true, an error is raised
  3800     "
  3801     ^ self detect:aBlock ifNone:[self errorNotFound]
  3802 !
  3803 
  3804 detect:aBlock ifNone:exceptionBlock
  3805     "evaluate the argument, aBlock for each item in the selection until the
  3806      block returns true; in this case return the element which caused the
  3807      true evaluation.
  3808      If none of the evaluations returns true, the result of the evaluation
  3809      of the exceptionBlock is returned
  3810     "
  3811     |cashedSelection|
  3812 
  3813     cashedSelection := selection.
  3814     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3815   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  3816 !
  3817 
  3818 detectLast:aBlock
  3819     "evaluate the argument, aBlock for each item in the selection until
  3820      the block returns true; in this case return the element which caused
  3821      the true evaluation. The items are processed in reverse order.
  3822      If none of the evaluations returns true, an error is raised
  3823     "
  3824     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  3825 !
  3826 
  3827 detectLast:aBlock ifNone:exceptionBlock
  3828     "evaluate the argument, aBlock for each item in the selection until
  3829      the block returns true; in this case return the element which caused
  3830      the true evaluation. The items are processed in reverse order.
  3831      If none of the evaluations returns true, the result of the evaluation
  3832      of the exceptionBlock is returned
  3833     "
  3834     |cashedSelection|
  3835 
  3836     cashedSelection := selection.
  3837     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3838   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  3839 ! !
  3840 
  3841 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
  3842 
  3843 includes:anItem
  3844     "returns true if the item is in the current selection
  3845     "
  3846     |cashedSelection|
  3847 
  3848     cashedSelection := selection.
  3849     cashedSelection isNil ifTrue:[^ false].
  3850  ^  cashedSelection includesIdentical:anItem
  3851 !
  3852 
  3853 includesAll:aCollection
  3854     "return true, if all items of the collection are included in the current selection
  3855     "
  3856     |cashedSelection|
  3857 
  3858     aCollection size ~~ 0 ifTrue:[
  3859         cashedSelection := selection.
  3860         cashedSelection isNil ifTrue:[ ^ false ].
  3861 
  3862         aCollection do:[:el|
  3863             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  3864         ]
  3865     ].
  3866     ^ true
  3867 !
  3868 
  3869 includesAny:aCollection
  3870     "return true, if the any item of the collection is in the current selection
  3871     "
  3872     |cashedSelection|
  3873 
  3874     aCollection notNil ifTrue:[
  3875         cashedSelection := selection.
  3876 
  3877         cashedSelection notNil ifTrue:[
  3878             aCollection do:[:el|
  3879                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  3880             ]
  3881         ]
  3882     ].
  3883     ^ false
  3884 !
  3885 
  3886 includesIdentical:anItem
  3887     "returns true if the item is in the current selection
  3888     "
  3889     ^ self includes:anItem
  3890 !
  3891 
  3892 isEmpty
  3893     "returns true if the current selection is empty
  3894     "
  3895     ^ selection size == 0
  3896 !
  3897 
  3898 isSelected:anItem
  3899     "returns true if the item is in the current selection
  3900     "
  3901     ^ self includes:anItem
  3902 !
  3903 
  3904 notEmpty
  3905     "returns true if the current selection is not empty
  3906     "
  3907     ^ selection size ~~ 0
  3908 ! !
  3909 
  3910 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
  3911 
  3912 documentation
  3913 "
  3914     Kind of HierarchicalList class which contains all the visible
  3915     ViewTreeItem's and the root, the anchor of the hierarchical list.
  3916 
  3917     [Instance variables:]
  3918         treeModel       <ViewTreeModel>         all events are delegated to
  3919         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  3920 
  3921 
  3922     [author:]
  3923         Claus Atzkern
  3924 
  3925     [see also:]
  3926         HierarchicalList
  3927         ViewTreeModel
  3928         ViewTreeItem
  3929 "
  3930 ! !
  3931 
  3932 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
  3933 
  3934 root:theRoot
  3935     "set the root item; delegate events to my treeModel
  3936     "
  3937     |rootView|
  3938 
  3939     theRoot == root ifTrue:[^ self].
  3940 
  3941     rootView := self rootView.
  3942     super root:theRoot.
  3943 
  3944     rootView notNil ifTrue:[ |wgrp|
  3945         wgrp := rootView windowGroup.
  3946 
  3947         wgrp notNil ifTrue:[
  3948            wgrp removePreEventHook:treeModel.
  3949            wgrp removePostEventHook:self.
  3950         ].
  3951     ].
  3952 
  3953     super root:theRoot.
  3954     rootView := self rootView.
  3955 
  3956     rootView notNil ifTrue:[
  3957         "must setup a task because there might not exist a windowGroup at the moment
  3958         "
  3959         [   |wgrp|
  3960 
  3961             [rootView == self rootView] whileTrue:[
  3962                 wgrp := rootView windowGroup.
  3963                 wgrp notNil ifTrue:[
  3964                     rootView := nil.
  3965                     wgrp addPreEventHook:treeModel.
  3966                     wgrp addPostEventHook:self.
  3967                 ] ifFalse:[
  3968                     Delay waitForMilliseconds:100.
  3969                 ].
  3970             ].
  3971 
  3972         ] forkAt:(Processor userSchedulingPriority + 2).
  3973     ].
  3974     treeModel notNil ifTrue:[
  3975         treeModel targetWidgetChanged.
  3976     ].
  3977     
  3978     ^ root.
  3979 !
  3980 
  3981 rootView
  3982     "returns the widget assigned to the root or nil
  3983     "
  3984     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  3985 !
  3986 
  3987 treeModel
  3988     "returne the treeModel, a ViewTreeModel
  3989     "
  3990     ^ treeModel
  3991 ! !
  3992 
  3993 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
  3994 
  3995 additionalLabelForItem:anItem
  3996     "answer the additional lable for an item or nil"
  3997 
  3998     |l applClass applClassName|
  3999 
  4000     l := nil.
  4001     showWidgetNames == true ifTrue:[
  4002         l := '"', anItem widget name, '"'
  4003     ].
  4004 
  4005     anItem isApplicationClass ifTrue:[
  4006         applClass := anItem applicationClass.
  4007         applClass notNil ifTrue:[   
  4008             applClassName := '[', applClass name allBold, ']'.
  4009             l := (l isNil ifTrue:[''] ifFalse:[l , ' ']) , applClassName
  4010         ].
  4011     ].
  4012     ^ l
  4013 !
  4014 
  4015 showWidgetNames
  4016     "answer true if the additional text is the widget name
  4017      otherwise the name of the application"
  4018 
  4019     ^ showWidgetNames ? true
  4020 !
  4021 
  4022 showWidgetNames:aBoolean
  4023     "set true if the additional text is the widget name
  4024      otherwise the name of the application"
  4025 
  4026     self showWidgetNames == aBoolean ifFalse:[
  4027         showWidgetNames := aBoolean.
  4028 
  4029         root notNil ifTrue:[
  4030             root recursiveAdditionalNameBehaviourChanged.
  4031             self changed.
  4032         ].
  4033     ].
  4034 ! !
  4035 
  4036 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
  4037 
  4038 processEvent:anEvent
  4039     "post process event
  4040     "
  4041     ^ treeModel isInTestMode not
  4042 ! !
  4043 
  4044 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
  4045 
  4046 on:aModel
  4047     "set the model, a ViewTreeModel
  4048     "
  4049     treeModel := aModel.
  4050     showRoot  := true.
  4051     "/ showWidgetNames := false.
  4052     showWidgetNames := true.
  4053 ! !
  4054 
  4055 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
  4056 
  4057 detectItemRespondsToView:aView
  4058     "returns the bottom-most item which contains the view
  4059     "
  4060     |view item topView|
  4061 
  4062     root notNil ifTrue:[
  4063         view    := aView.
  4064         topView := root widget.
  4065 
  4066         [ view notNil ] whileTrue:[
  4067             topView == view ifTrue:[^ root].
  4068             item := root recursiveDetect:[:el| el widget == view ].
  4069             item notNil ifTrue:[^ item].
  4070             view := view superView
  4071         ]
  4072     ].
  4073     ^ nil
  4074 !
  4075 
  4076 recursiveDetect:aOneOrgBlock
  4077     "recursive find the first child, for which evaluation 
  4078      of the block returns true; if none nil is returned
  4079     "
  4080     root notNil ifTrue:[
  4081         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  4082       ^ root recursiveDetect:aOneOrgBlock
  4083     ].
  4084     ^ nil
  4085 ! !
  4086 
  4087 !ViewTreeInspectorApplication class methodsFor:'documentation'!
  4088 
  4089 version
  4090     ^ '$Header$'
  4091 !
  4092 
  4093 version_CVS
  4094     ^ '$Header$'
  4095 ! !
  4096 
  4097 
  4098 ViewTreeInspectorApplication initialize!
  4099 ViewTreeInspectorApplication::ViewTreeItem initialize!