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