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