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