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