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