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