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