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