Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 02 Dec 2014 19:23:38 +0100
changeset 3169 54d9e27b384d
parent 3168 894c517d8696
child 3171 16cec0f0e3b4
permissions -rw-r--r--
class: Tools::ViewTreeInspectorApplication
comment/format in: #middleButtonMenu
changed: #objectToInspectOrBrowse:
     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     |inst|
  1931 
  1932     (inst := self objectToInspectOrBrowse:what) isNil ifTrue:[^ self].
  1933     inst class browserClass openInClass:(inst class) selector:nil
  1934 
  1935     "Modified: / 28-08-2013 / 23:57:42 / cg"
  1936 !
  1937 
  1938 doCatchEvents
  1939     model catchEvents:true.
  1940     isCatchingEventsChannel value:true.
  1941 "/    ((builder componentAt:'toolbarMenu') itemAt:#doUncatchEvents) 
  1942 "/        enabled:true;
  1943 "/        label:(self class releaseViewIcon);
  1944 "/        activeHelpKey:#doUncatchEvents.
  1945 !
  1946 
  1947 doDestroy
  1948     "destroy the current selected view"
  1949 
  1950     |item parent|
  1951 
  1952     item := model selectedItem.
  1953     item isNil ifTrue:[ ^ self].
  1954 
  1955     parent := item parent.
  1956 
  1957     parent isNil ifTrue:[
  1958         "/ the root
  1959         model withSelectionHiddenDo:[item deleteAll].
  1960       ^ self
  1961     ].
  1962 
  1963     model withSelectionHiddenDo:[
  1964         |idx nsel|
  1965 
  1966         idx := parent identityIndexOf:item.
  1967 
  1968         idx == parent size ifTrue:[
  1969             nsel := parent at:(idx - 1) ifAbsent:parent
  1970         ] ifFalse:[
  1971             nsel := parent at:(idx + 1)
  1972         ].
  1973         model setValue:nil.
  1974         item delete.
  1975 
  1976         parent isLayoutContainer ifTrue:[
  1977             parent widget sizeChanged:nil
  1978         ].
  1979         model value:nsel.
  1980     ].
  1981 !
  1982 
  1983 doFlash
  1984     "flash the selected view"
  1985 
  1986     |view|
  1987 
  1988     view := self selectedView.
  1989     view isNil ifTrue:[ ^ self].
  1990 
  1991     view shown ifTrue:[
  1992         model withSelectionHiddenDo:[
  1993             view perform:#flash ifNotUnderstood:nil.
  1994         ].
  1995     ].
  1996 !
  1997 
  1998 doInspect:what
  1999     "open inspector on:
  2000         #view           inspect class
  2001         #group          inspect windowGroup
  2002         #model          inspect model
  2003         #application    inspect application
  2004         #controller     inspect controller
  2005         #process        inspect application's process
  2006     "
  2007 
  2008     |inst|
  2009 
  2010     (inst := self objectToInspectOrBrowse:what) isNil ifTrue:[^ self].
  2011     inst inspect.
  2012 
  2013     "Modified: / 28-08-2013 / 23:58:27 / cg"
  2014 !
  2015 
  2016 doOpenProcessMonitor
  2017     (ProcessMonitorV2 ? ProcessMonitor) open
  2018 
  2019     "Created: / 25-07-2013 / 12:34:23 / cg"
  2020 !
  2021 
  2022 doPickView
  2023     "pick a window's topView"
  2024 
  2025     |screen clickedView topWindow cursor|
  2026 
  2027     self doUnpick.
  2028 
  2029     cursor := Cursor fromImage:(self class crossHairIcon).
  2030 
  2031     screen := Screen current.
  2032     clickedView := screen viewFromPoint:(screen pointFromUserShowing:cursor).
  2033     clickedView isNil ifTrue:[^ self].
  2034 
  2035     topWindow := clickedView topView.
  2036 
  2037     (    topWindow == Screen current rootView
  2038      or:[topWindow == self window topView]
  2039     ) ifTrue:[
  2040         ^ self
  2041     ].
  2042 
  2043     self showWindow:clickedView.
  2044 !
  2045 
  2046 doRedraw
  2047     "redraw the app"
  2048 
  2049     model rootView notNil ifTrue:[
  2050         model rootView withAllSubViewsDo:[:v | v "redraw; "invalidate].
  2051     ]
  2052 !
  2053 
  2054 doSelectNextElementStartingIn:anItem forWhich:aBlock
  2055     |startItem firstFound searchNext|
  2056 
  2057     startItem  := model last.
  2058     searchNext := startItem notNil.        
  2059     firstFound := nil.
  2060 
  2061     anItem recursiveDo:[:el|
  2062         el == startItem ifTrue:[
  2063             searchNext := false
  2064         ] ifFalse:[
  2065             (aBlock value:el) ifTrue:[
  2066                 searchNext ifFalse:[^ model selectItem:el].
  2067 
  2068                 firstFound isNil ifTrue:[
  2069                     firstFound := el
  2070                 ]
  2071             ]
  2072         ]
  2073     ].
  2074     firstFound notNil ifTrue:[
  2075         self window beep.
  2076         model selectItem:firstFound
  2077     ].
  2078 !
  2079 
  2080 doSelectNextOfApplicationClass:aClass startingIn:anItem
  2081     self doSelectNextElementStartingIn:anItem forWhich:[:el | (self resolveApplicationClassFor:el) == aClass].
  2082 !
  2083 
  2084 doSelectNextOfClass:aClass startingIn:anItem
  2085     self doSelectNextElementStartingIn:anItem forWhich:[:el | el widget class == aClass].
  2086 !
  2087 
  2088 doUncatchEvents
  2089     "release the inspected window (no longer catch its events)"
  2090 
  2091     model catchEvents:false.
  2092     isCatchingEventsChannel value:false.
  2093 "/    ((builder componentAt:'toolbarMenu') itemAt:#doUncatchEvents) 
  2094 "/        label:(self class releaseViewIcon);
  2095 "/        enabled:false;
  2096 "/        activeHelpKey:#doCatchEvents.
  2097     self doRedraw
  2098 !
  2099 
  2100 doUnpick
  2101     "release current picked window and contained subwindows"
  2102 
  2103     self setRootItem:nil.
  2104 !
  2105 
  2106 objectToInspectOrBrowse:what
  2107     "return one of:
  2108         #view           inspect class
  2109         #group          inspect windowGroup
  2110         #model          inspect model
  2111         #application    inspect application
  2112         #controller     inspect controller
  2113         #process        inspect application's process
  2114     "
  2115     |view inst|
  2116 
  2117     view := self selectedView.
  2118     view isNil ifTrue:[^ nil].
  2119 
  2120              what == #group       ifTrue:[ inst := view windowGroup ]
  2121     ifFalse:[what == #model       ifTrue:[ inst := view model ]
  2122     ifFalse:[what == #application ifTrue:[ inst := view application ]
  2123     ifFalse:[what == #controller  ifTrue:[ inst := view controller  ]
  2124     ifFalse:[what == #process     ifTrue:[ inst := view windowGroup process  ]
  2125     ifFalse:[what == #sensor      ifTrue:[ inst := view sensor  ]
  2126     ifFalse:[inst := view  ]]]]]].
  2127 
  2128     (inst isNil and:[what == #application]) ifTrue:[
  2129         inst := view topView
  2130     ].
  2131     ^ inst
  2132 
  2133     "Modified: / 28-08-2013 / 23:58:27 / cg"
  2134 !
  2135 
  2136 openDocumentation
  2137     HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
  2138 !
  2139 
  2140 showWindow:aView
  2141     "show a particular window's topView hierarchy,
  2142      select the given view"
  2143 
  2144     | topWindow |
  2145 
  2146     topWindow := aView topView.
  2147 
  2148     self doCatchEvents.
  2149     self setRootItem:(ViewTreeItem buildViewsFrom:topWindow).
  2150     self selectView:aView.
  2151 ! !
  2152 
  2153 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
  2154 
  2155 buildFromList:aList onGC:aMenu
  2156     |tabSpec menu w menuPanel|
  2157 
  2158     w := 0.
  2159     aList do:[:el| w := w max:(el widthOn:aMenu) ].
  2160 
  2161     tabSpec := TabulatorSpecification new.
  2162     tabSpec unit:#pixel.
  2163     tabSpec positions:#(0     1.5 ).
  2164     tabSpec align:#(#left #left).
  2165 
  2166     w := w + 15.
  2167     tabSpec positions:(Array with:0 with:w).
  2168 
  2169     menu := Menu new.
  2170 
  2171     aList do:[:el|
  2172         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
  2173     ].
  2174     menuPanel := MenuPanel menu:menu.
  2175     ^ menuPanel
  2176 ! !
  2177 
  2178 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
  2179 
  2180 separator
  2181     ^ self new
  2182 !
  2183 
  2184 title:aTitle value:aValue
  2185     ^ self title:aTitle value:aValue action:nil
  2186 !
  2187 
  2188 title:aTitle value:aValue action:anAction
  2189     ^ self new title:aTitle value:aValue action:anAction
  2190 ! !
  2191 
  2192 !ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
  2193 
  2194 title
  2195     ^ title
  2196 ! !
  2197 
  2198 !ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
  2199 
  2200 asMenuItemWithTabulatorSpecification:aTabSpec
  2201     |array|
  2202 
  2203     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
  2204 
  2205     array := Array with:(title, ':') with:'------'.
  2206 
  2207     value notNil ifTrue:[
  2208         array at:2 put:(value printString, ' ')
  2209     ].
  2210 
  2211    ^ MenuItem 
  2212         label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
  2213         value:action
  2214 ! !
  2215 
  2216 !ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
  2217 
  2218 title:aTitle value:aValue action:anAction
  2219     "test for separator
  2220     "
  2221     title  := aTitle withoutSeparators.
  2222     action := anAction.
  2223 
  2224     aValue notNil ifTrue:[
  2225         value := aValue printString.
  2226 
  2227         value size > 70 ifTrue:[
  2228             value := value copyFrom:1 to:70.
  2229             value := value, '...'
  2230         ]
  2231     ].
  2232 ! !
  2233 
  2234 !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
  2235 
  2236 isSeparator
  2237     ^ title isNil
  2238 !
  2239 
  2240 widthOn:aGC
  2241     title isNil ifTrue:[^ 5].  "/ separator
  2242     ^ title widthOn:aGC
  2243 ! !
  2244 
  2245 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
  2246 
  2247 buildViewsFrom:aView
  2248     "build the items starting from a source view;
  2249      returns the anhor.
  2250     "
  2251     |item subViews subItems|
  2252 
  2253     aView isNil ifTrue:[^ nil].
  2254 
  2255     item     := self forView:aView.
  2256     subViews := aView subViews.
  2257 
  2258     subViews notEmptyOrNil ifTrue:[
  2259         subItems := OrderedCollection new.
  2260         subViews do:[:aSubView|
  2261             subItems add:(self buildViewsFrom:aSubView).
  2262         ].
  2263         item children:subItems.
  2264     ].
  2265     ^ item
  2266 ! !
  2267 
  2268 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
  2269 
  2270 documentation
  2271 "
  2272     ViewTreeItems represants a pickable object within a ViewTreeModel.
  2273     The class is used to build up the hierarchical tree.
  2274 
  2275     [Instance variables:]
  2276         widget        <View>            the widget represented by the item
  2277         spec          <UISpecification> the UISpecification or nil
  2278 
  2279     [Class variables:]
  2280         HandleExtent  <Point>           keeps the extent of a handle
  2281 
  2282 
  2283     [author:]
  2284         Claus Atzkern
  2285 
  2286     [see also:]
  2287         HierarchicalItem
  2288         ViewTreeModel
  2289 "
  2290 !
  2291 
  2292 version
  2293     ^ '$Header$'
  2294 ! !
  2295 
  2296 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
  2297 
  2298 initialize
  2299     "set the extent of the Handle
  2300     "
  2301     HandleExtent := 6@6.
  2302 ! !
  2303 
  2304 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
  2305 
  2306 forView:aView
  2307     |item|
  2308 
  2309     item := self basicNew initialize.
  2310     item forView:aView.
  2311   ^ item
  2312 !
  2313 
  2314 new
  2315     self error:'not allowed'.
  2316   ^ nil
  2317 !
  2318 
  2319 on:aView withSpec:aSpec
  2320     |item|
  2321 
  2322     item := self basicNew initialize.
  2323     item on:aView withSpec:aSpec.
  2324   ^ item
  2325 ! !
  2326 
  2327 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
  2328 
  2329 applicationClass
  2330     |appl|
  2331 
  2332     widget notNil ifTrue:[
  2333         appl := widget application.
  2334         appl notNil ifTrue:[^ appl class ].
  2335     ].
  2336     ^ nil
  2337 !
  2338 
  2339 isDrawnShown
  2340     "returns true if the last display operations was done during the widget was shown
  2341     "
  2342     ^ isDrawnShown
  2343 !
  2344 
  2345 isDrawnShown:aBoolean
  2346     isDrawnShown := aBoolean.
  2347 !
  2348 
  2349 rootView
  2350     "returns the widget assigned to the root or nil
  2351     "
  2352     ^ parent rootView
  2353 !
  2354 
  2355 specClass
  2356     "returns the spec-class assigned to the item
  2357     "
  2358     ^ widget specClass
  2359 !
  2360 
  2361 treeModel
  2362     "returns the assigned treeModel, an instance of ViewTreeModel
  2363     "
  2364     ^ parent treeModel
  2365 !
  2366 
  2367 widget
  2368     "returns the widget assigned to the item
  2369     "
  2370     ^ widget
  2371 ! !
  2372 
  2373 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
  2374 
  2375 boundsRelativeToRoot
  2376     "returns the bounds relative to the root widget
  2377     "
  2378     ^ self originRelativeToRoot extent:(widget extent)
  2379 !
  2380 
  2381 cornerRelativeToRoot
  2382     "returns the corner relative to the root widget
  2383     "
  2384     ^ self originRelativeToRoot + (widget extent)
  2385 !
  2386 
  2387 extent
  2388     "returns the extent of the widget
  2389     "
  2390     ^ widget extent
  2391 !
  2392 
  2393 layoutType
  2394     "returns the type of layout assigned to the wiget; nil if the
  2395      superView cannot resize its sub widgets
  2396     "
  2397     |layout specClass superView|
  2398 
  2399     (superView := widget superView) isNil ifTrue:[
  2400         ^ #Extent
  2401     ].
  2402         
  2403     specClass := superView specClass.
  2404 
  2405     (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
  2406         ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
  2407     ].
  2408 
  2409     (layout := widget geometryLayout) isNil ifTrue:[
  2410         ^ #Extent
  2411     ].
  2412 
  2413     layout isLayout ifTrue:[
  2414         layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
  2415         layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
  2416         layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
  2417     ] ifFalse:[
  2418         layout isRectangle          ifTrue:[ ^ #Rectangle ].
  2419         layout isPoint              ifTrue:[ ^ #Point ].
  2420 
  2421     ].
  2422     Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2423   ^ nil
  2424 !
  2425 
  2426 originRelativeToRoot
  2427     "returns the origin relative to the root widget
  2428     "
  2429     ^ widget originRelativeTo:(self rootView)
  2430 ! !
  2431 
  2432 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
  2433 
  2434 children
  2435     "redefined: optimize
  2436     "
  2437     ^ children
  2438 !
  2439 
  2440 hasChildren
  2441     |subViews list item|
  2442 
  2443     children size ~~ 0 ifTrue:[
  2444         ^ true
  2445     ].
  2446     isExpanded := false.
  2447     subViews   := widget subViews.
  2448 
  2449     subViews size == 0 ifTrue:[^ false].
  2450 
  2451     list := OrderedCollection new.
  2452 
  2453     subViews do:[:aSubView|
  2454         item := self class buildViewsFrom:aSubView.
  2455         item parent:self.
  2456         list add:item.
  2457     ].
  2458     children := list.
  2459     ^ true
  2460 !
  2461 
  2462 size
  2463     "redefined: returns list of children
  2464     "
  2465     ^ children size
  2466 ! !
  2467 
  2468 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
  2469 
  2470 additionalLabelForItem:anItem
  2471     "answer an additional label for an Item"
  2472 
  2473     parent notNil ifTrue:[
  2474         ^ parent additionalLabelForItem:anItem
  2475     ].
  2476     ^ nil
  2477 !
  2478 
  2479 displayIcon:anIcon atX:x y:y on:aGC
  2480     |x0 y0 y1 w|
  2481 
  2482     super displayIcon:anIcon atX:x y:y on:aGC.
  2483 
  2484     self exists ifFalse:[
  2485         aGC paint:(Color red).
  2486 
  2487         y0 := y + 1.
  2488         y1 := y + anIcon height - 2.
  2489 
  2490         x0 := x - 1.
  2491         w  := anIcon width.
  2492 
  2493         2 timesRepeat:[
  2494             aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
  2495             aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
  2496             x0 := x0 + 1.
  2497         ].
  2498     ].
  2499 !
  2500 
  2501 displayOn:aGC x:x y:y h:h
  2502     |labelHeight additionalName label isValidAndShown|
  2503 
  2504     label := self label.
  2505     label isEmptyOrNil ifTrue:[^ self].
  2506 
  2507     widget id isNil ifTrue:[
  2508         isDrawnShown := false.
  2509 
  2510         self exists ifFalse:[
  2511             xOffsetAdditionalName := nil.
  2512         ].
  2513         isValidAndShown := false.
  2514     ] ifFalse:[
  2515         isValidAndShown := widget shown.
  2516     ].
  2517     isValidAndShown ifFalse:[
  2518         label := Text string:label emphasis:#italic.
  2519         label colorizeAllWith:Color gray.
  2520     ].
  2521 
  2522     labelHeight := self heightOn:aGC.
  2523     self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
  2524 
  2525     xOffsetAdditionalName notNil ifTrue:[
  2526         additionalName := self additionalLabelForItem:self.
  2527 
  2528         additionalName notNil ifTrue:[
  2529             self displayLabel:additionalName
  2530                             h:labelHeight on:aGC
  2531                             x:(x + xOffsetAdditionalName)
  2532                             y:y
  2533                             h:h.
  2534         ] ifFalse:[
  2535             xOffsetAdditionalName := nil.
  2536         ].
  2537     ].
  2538 !
  2539 
  2540 recursiveAdditionalNameBehaviourChanged
  2541     width := xOffsetAdditionalName := nil.
  2542 
  2543     children notNil ifTrue:[
  2544         children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
  2545     ].
  2546 !
  2547 
  2548 widthOn:aGC
  2549     "return the width of the receiver, if it is to be displayed on aGC
  2550     "
  2551     |additionalName|
  2552 
  2553     width isNil ifTrue:[
  2554         width := self widthOf:(self label) on:aGC.
  2555         width := width + 2.
  2556 
  2557         additionalName := self additionalLabelForItem:self.
  2558 
  2559         additionalName notNil ifTrue:[
  2560             xOffsetAdditionalName := width + 10.
  2561             width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
  2562             width := width + 2.
  2563         ] ifFalse:[
  2564             xOffsetAdditionalName := nil.
  2565         ].
  2566     ].
  2567     ^ width
  2568 ! !
  2569 
  2570 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
  2571 
  2572 handlesDo:aTwoArgAction
  2573     "evaluate the two arg block on each handle; the arguments to the block is
  2574      the rectangle relative to the rootView and the handle type which is
  2575      set to nil if not resizeable.
  2576 
  2577      TYPES:     type    position( X - Y )
  2578                 -------------------------        
  2579                 #LT     Left   - Top
  2580                 #LC     Left   - Center
  2581                 #LB     Left   - Bottom
  2582                 #CT     Center - Top
  2583                 #CB     Center - Bottom
  2584                 #RT     Right  - Top
  2585                 #RC     Right  - Center
  2586                 #RB     Right  - Bottom
  2587 
  2588                 nil     ** handle not pickable **
  2589     "
  2590     |type relOrg relCrn maxExt rootView w h
  2591      xL    "{ Class:SmallInteger }"
  2592      xC    "{ Class:SmallInteger }"
  2593      xR    "{ Class:SmallInteger }"
  2594      yT    "{ Class:SmallInteger }"
  2595      yC    "{ Class:SmallInteger }"
  2596      yB    "{ Class:SmallInteger }"
  2597     |
  2598     rootView := self rootView.
  2599     relOrg   := widget originRelativeTo:rootView.
  2600     relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
  2601 
  2602     relOrg   := relOrg - (HandleExtent // 2).
  2603     relCrn   := relOrg + widget extent.
  2604     maxExt   := rootView extent - HandleExtent.
  2605 
  2606     xL := relOrg x max:0.
  2607     xR := relCrn x min:(maxExt x).
  2608     xC := xR + xL // 2.
  2609 
  2610     yT := relOrg y max:0.
  2611     yB := relCrn y min:(maxExt y).
  2612     yC := yB + yT // 2.
  2613 
  2614     type := self layoutType.
  2615     w   := HandleExtent x.
  2616     h   := HandleExtent y.
  2617 
  2618     (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
  2619         aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
  2620         aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
  2621         aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
  2622         aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
  2623         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2624         aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
  2625         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2626         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2627       ^ self
  2628     ].
  2629 
  2630     aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
  2631     aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
  2632     aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
  2633 
  2634     type == #Extent ifTrue:[
  2635         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2636         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2637         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2638       ^ self
  2639     ].
  2640     aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
  2641 !
  2642 
  2643 recursiveEachVisibleItemDo:anOneArgBlock
  2644     "recursive evaluate the block on each child which is visible
  2645     "
  2646     (isExpanded and:[children size > 0]) ifTrue:[
  2647         children do:[:aChild|
  2648             anOneArgBlock value:aChild.
  2649             aChild recursiveEachVisibleItemDo:anOneArgBlock.
  2650         ]
  2651     ].
  2652 !
  2653 
  2654 subViewsDo:aOneArgBlock
  2655     "evaluate aBlock for all subviews other than InputView's   
  2656     "
  2657     |subViews|
  2658 
  2659     subViews := widget subViews.
  2660 
  2661     subViews notNil ifTrue:[
  2662         subViews do:aOneArgBlock
  2663     ].
  2664 ! !
  2665 
  2666 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
  2667 
  2668 forView:aView
  2669     widget := aView.
  2670 !
  2671 
  2672 initialize
  2673     "setup default attributes
  2674     "
  2675     super initialize.
  2676     isDrawnShown := false.
  2677     isExpanded   := false.
  2678     children     := OrderedCollection new.
  2679 ! !
  2680 
  2681 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
  2682 
  2683 delete
  2684     "delete self and all contained items; the assigned views are destroyed
  2685      in case of rootView, only the children are deleted
  2686     "
  2687     parent isHierarchicalItem ifTrue:[
  2688         self criticalDo:[
  2689             parent remove:self.
  2690             widget destroy.
  2691         ]
  2692     ] ifFalse:[
  2693         self deleteAll
  2694     ].
  2695 !
  2696 
  2697 deleteAll
  2698     "delete all contained items; the assigned views are destroyed
  2699     "
  2700     children size == 0 ifTrue:[^ self].
  2701 
  2702     self criticalDo:[
  2703         self nonCriticalDo:[:el| el widget destroy ].
  2704         self removeAll
  2705     ].
  2706 ! !
  2707 
  2708 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
  2709 
  2710 asLayoutFrame
  2711     "convert the layout of the widget to a LayoutFrame;
  2712     "
  2713     |extent layout newLyt lftFrc lftOff topFrc topOff|
  2714 
  2715     layout := widget geometryLayout.
  2716 
  2717     layout isNil ifTrue:[
  2718         ^ widget bounds asLayout
  2719     ].
  2720 
  2721     layout isLayout ifFalse:[
  2722         layout isRectangle ifTrue:[
  2723             ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
  2724                            topOffset:(layout top) bottomOffset:(layout bottom)
  2725         ].
  2726         layout isPoint ifTrue:[
  2727             extent := widget extent.
  2728           ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
  2729                          topOffset:(layout y) bottomOffset:(layout y + extent y)
  2730         ].
  2731 
  2732         Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2733       ^ nil
  2734     ].
  2735 
  2736     layout isLayoutFrame ifTrue:[ ^ layout copy ].    
  2737 
  2738     lftFrc := layout leftFraction.
  2739     lftOff := layout leftOffset.
  2740     topFrc := layout topFraction.
  2741     topOff := layout topOffset.
  2742     extent := widget extent.
  2743 
  2744     newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
  2745                          rightFraction:lftFrc offset:(lftOff + extent x)
  2746                            topFraction:topFrc offset:topOff
  2747                         bottomFraction:topFrc offset:(topOff + extent y).
  2748 
  2749     (      layout isAlignmentOrigin
  2750      and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
  2751     ) ifTrue:[
  2752         |svRc prBd dlta|
  2753 
  2754         svRc := widget superView viewRectangle.
  2755         prBd := widget preferredBounds.
  2756 
  2757         dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
  2758                  - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
  2759                 ) rounded.
  2760 
  2761         newLyt   leftOffset:(lftOff + dlta x).
  2762         newLyt  rightOffset:(lftOff + extent x + dlta x).
  2763         newLyt    topOffset:(topOff + dlta y).
  2764         newLyt bottomOffset:(topOff + extent y + dlta y).
  2765     ].
  2766     ^ newLyt
  2767 !
  2768 
  2769 moveLeft:l top:t
  2770     "move the widget n pixele left and right
  2771     "
  2772     |layout|
  2773 
  2774     self isMoveable ifFalse:[ ^ self ].
  2775 
  2776     (layout := widget geometryLayout) isNil ifTrue:[
  2777         "Extent"
  2778         widget origin:(widget origin + (l@t)).
  2779       ^ self
  2780     ].
  2781 
  2782     layout := layout copy.
  2783 
  2784     layout isLayout ifTrue:[
  2785         layout leftOffset:(layout leftOffset + l)
  2786                 topOffset:(layout topOffset  + t).
  2787 
  2788         layout isLayoutFrame ifTrue:[
  2789             layout  rightOffset:(layout rightOffset  + l).
  2790             layout bottomOffset:(layout bottomOffset + t).
  2791         ]
  2792 
  2793     ] ifFalse:[
  2794         layout isRectangle ifTrue:[
  2795             layout setLeft:(layout left + l).
  2796             layout  setTop:(layout top  + t).
  2797         ] ifFalse:[
  2798             layout isPoint ifFalse:[^ self].
  2799             layout x:(layout x + l) y:(layout y + t).
  2800         ]
  2801     ].
  2802     widget geometryLayout:layout.
  2803 !
  2804 
  2805 resizeLeft:l top:t right:r bottom:b
  2806     "resize the widget measured in pixels
  2807     "
  2808     |layout|
  2809 
  2810     self isResizeable ifFalse:[
  2811         ^ self
  2812     ].
  2813 
  2814     (layout := widget geometryLayout) isNil ifTrue:[
  2815         "Extent"
  2816         (r == l and:[b == t]) ifFalse:[
  2817             widget extent:(widget computeExtent + ((r-l) @ (b-t))).
  2818         ].
  2819         ^ self
  2820     ].
  2821 
  2822     layout isLayout ifTrue:[
  2823         layout := layout copy.
  2824 
  2825         layout leftOffset:(layout leftOffset + l)
  2826                 topOffset:(layout topOffset  + t).
  2827 
  2828         layout isLayoutFrame ifTrue:[
  2829             layout bottomOffset:(layout bottomOffset + b).
  2830             layout  rightOffset:(layout rightOffset  + r).
  2831         ]
  2832     ] ifFalse:[
  2833         layout isRectangle ifFalse:[^ self].
  2834         layout := layout copy.
  2835 
  2836         layout left:(layout left   + l)
  2837               right:(layout right  + r)
  2838                 top:(layout top    + t)
  2839              bottom:(layout bottom + b).
  2840     ].
  2841     widget geometryLayout:layout.
  2842 ! !
  2843 
  2844 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
  2845 
  2846 updateChildren
  2847     |list|
  2848 
  2849     self do:[:el|
  2850         el exists ifTrue:[
  2851             el updateChildren.
  2852         ] ifFalse:[
  2853             list isNil ifTrue:[list := OrderedCollection new].
  2854             list add:el.
  2855         ]
  2856     ].
  2857     list notNil ifTrue:[
  2858         list do:[:el| self remove:el ].
  2859     ].
  2860 !
  2861 
  2862 updateFromChildren:mergedList
  2863     "update my children against the list of items derived from
  2864      the merged list.
  2865     "
  2866 
  2867     mergedList size == 0 ifTrue:[ ^ self removeAll ].
  2868     children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
  2869 
  2870     self criticalDo:[
  2871         self nonCriticalDo:[:el| |wdg|
  2872             wdg := el widget.
  2873             mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
  2874         ].
  2875 
  2876         mergedList keysAndValuesDo:[:i :el| |wdg e2|
  2877             wdg := el widget.
  2878 
  2879             e2  := self at:i ifAbsent:nil.
  2880 
  2881             (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
  2882                 self add:el beforeIndex:i
  2883             ]
  2884         ]
  2885     ].
  2886 ! !
  2887 
  2888 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
  2889 
  2890 icon
  2891     "get the icon used for presentation
  2892     "
  2893     |specClass model|
  2894 
  2895     specClass := self specClass.
  2896     specClass isNil ifTrue:[^ nil].
  2897 
  2898     model := self treeModel.
  2899 
  2900     model notNil ifTrue:[
  2901         ^ model iconAt:specClass ifNonePut:[specClass icon]
  2902     ].
  2903     ^ specClass icon
  2904 !
  2905 
  2906 label
  2907     "get the label used for presentation
  2908     "
  2909     ^ self string
  2910 !
  2911 
  2912 printOn:aStream
  2913     "append a a printed representation of the item to aStream
  2914     "
  2915     aStream nextPutAll:(self string)
  2916 !
  2917 
  2918 string
  2919     "get the string
  2920     "
  2921     ^ widget class name.
  2922 ! !
  2923 
  2924 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
  2925 
  2926 canChangeLayout
  2927     "returns true if the layout of the widget can be changed and the
  2928      layout is not organized by its superView
  2929     "
  2930     ^ self isResizeable
  2931 !
  2932 
  2933 canResizeSubComponents
  2934     "returns true if the widget can resize its sub components
  2935     "
  2936     |specClass|
  2937 
  2938     specClass := self specClass.
  2939 
  2940     specClass notNil ifTrue:[
  2941         ^ specClass canResizeSubComponents
  2942     ].
  2943     ^ false
  2944 !
  2945 
  2946 exists
  2947     widget id notNil ifTrue:[^ true ].
  2948 
  2949     exists ~~ false ifTrue:[
  2950         exists := false.
  2951 
  2952         widget superView notNil ifTrue:[
  2953             (parent isHierarchicalItem and:[parent exists]) ifTrue:[
  2954                 exists := (parent widget subViews includesIdentical:widget).
  2955             ].
  2956         ].
  2957     ].
  2958     ^ exists
  2959 !
  2960 
  2961 isApplicationClass
  2962     |cls|
  2963 
  2964     cls := widget class.
  2965 
  2966     ^ (    cls == ApplicationSubView
  2967         or:[cls == ApplicationWindow
  2968         or:[cls == SubCanvas]]
  2969       ) 
  2970 !
  2971 
  2972 isSelected
  2973     |model|
  2974 
  2975     model := self treeModel.
  2976     model notNil ifTrue:[^ model isSelected:self].
  2977     ^ false
  2978 !
  2979 
  2980 supportsSubComponents
  2981     "returns true if the widget supports sub components
  2982     "
  2983     |specClass|
  2984 
  2985     widget isScrollWrapper ifTrue:[
  2986         ^ false
  2987     ].
  2988     specClass := self specClass.
  2989 
  2990     specClass notNil ifTrue:[
  2991         ^ specClass supportsSubComponents
  2992     ].
  2993     ^ false
  2994 ! !
  2995 
  2996 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
  2997 
  2998 isInLayoutContainer
  2999     "returns true if the widget is in a layout container
  3000     "
  3001     |sv specClass|
  3002 
  3003     sv := widget superView.
  3004 
  3005     sv notNil ifTrue:[
  3006         specClass := sv specClass.
  3007 
  3008         specClass notNil ifTrue:[
  3009             ^ specClass isLayoutContainer
  3010         ].
  3011     ].
  3012     ^ false
  3013 !
  3014 
  3015 isLayoutContainer
  3016     "answer whether corresponding view instances of the spec class can contain
  3017      (and arrange) other view
  3018     "
  3019     |specClass|
  3020 
  3021     specClass := self specClass.
  3022 
  3023     specClass notNil ifTrue:[
  3024         ^ specClass isLayoutContainer
  3025     ].
  3026     ^ false
  3027 !
  3028 
  3029 isMoveable
  3030     "returns true if the widget is not in a layout container
  3031     "
  3032     self isInLayoutContainer ifFalse:[
  3033         ^ widget superView notNil
  3034     ].
  3035     ^ false
  3036 !
  3037 
  3038 isResizeable
  3039     "returns true if the widget is resizeable
  3040     "
  3041     |sv specClass|
  3042 
  3043     sv := widget superView.
  3044 
  3045     sv notNil ifTrue:[
  3046         specClass := sv specClass.
  3047 
  3048         specClass notNil ifTrue:[
  3049             ^ specClass canResizeSubComponents
  3050         ].
  3051     ].
  3052     ^ false
  3053 ! !
  3054 
  3055 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
  3056 
  3057 documentation
  3058 "
  3059     Instances of ViewTreeModel can be used as model on a View and all
  3060     it contained subviews for a HierarchicalListView.
  3061     The model keeps two values, the hierarchical representation of the views
  3062     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
  3063     It shows the selected items highlighted.
  3064 
  3065 
  3066     [Instance variables:]
  3067         lockSema            <Semaphore>         lock selection notifications and redraws
  3068 
  3069         testModeChannel     <ValueHolder>       true, than running in test mode.
  3070 
  3071         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
  3072 
  3073         selection           <Sequence or nil>   selected items or nil
  3074 
  3075         hiddenLevel         <Integer>           internal use; redrawing the selection
  3076                                                 only is done if the counter is 0.
  3077 
  3078         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
  3079 
  3080         selectedSuperItems  <Sequence>          list of selected super items; items selected
  3081                                                 but not contained in another selected item.
  3082 
  3083         inputEventAction    <Action>            called for each InputEvent
  3084 
  3085         mappedViewAction    <Action>            called for a new mapped view which
  3086                                                 can not be found in the current item list.
  3087 
  3088         beforeSelectionChangedAction <Action>   called before the selection changed
  3089 
  3090     [author:]
  3091         Claus Atzkern
  3092 
  3093     [see also:]
  3094         ViewTreeItem
  3095 "
  3096 !
  3097 
  3098 examples
  3099 "
  3100     example 1: pick any window and show views and contained views
  3101                                                                                 [exBegin]
  3102     |top sel model panel|
  3103 
  3104     model := ViewTreeModel new.
  3105     top   := StandardSystemView new; extent:440@400.
  3106     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
  3107     sel bottomInset:24.
  3108 
  3109     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
  3110     panel topInset:-24.
  3111     panel horizontalLayout:#fitSpace.
  3112 
  3113     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
  3114     Button label:'Pick Views' action:[  |win|
  3115                                         (     (win := Screen current viewFromUser) notNil
  3116                                          and:[(win := win topView) ~~ Screen current rootView
  3117                                          and:[win ~~ top]]
  3118                                         ) ifTrue:[
  3119                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
  3120                                         ] ifFalse:[
  3121                                             model rootItem:nil
  3122                                         ]
  3123                                      ] in:panel.
  3124 
  3125     sel  multipleSelectOk:true.
  3126     sel              list:model listOfItems.
  3127     sel             model:model.
  3128     sel          useIndex:false.
  3129 
  3130     sel doubleClickAction:[:i| |el|
  3131         el := model listOfItems at:i.
  3132         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
  3133     ].
  3134     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
  3135 
  3136     model inputEventAction:[:anEvent| |item|
  3137         anEvent isButtonEvent ifTrue:[
  3138             anEvent isButtonPressEvent ifTrue:[
  3139                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
  3140             ] ifFalse:[
  3141                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  3142                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
  3143                 ]
  3144             ]
  3145         ]
  3146     ].
  3147 
  3148     top openAndWait.
  3149     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
  3150 
  3151                                                                                 [exEnd]
  3152 "
  3153 ! !
  3154 
  3155 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
  3156 
  3157 application:anApplication
  3158     listOfItems application:anApplication.
  3159 !
  3160 
  3161 catchEvents:aBoolean
  3162     catchEvents := aBoolean.
  3163     aBoolean ifFalse:[
  3164         self redrawUnselected:selection andLock:false checkTestMode:false.
  3165     ].
  3166 !
  3167 
  3168 path
  3169     "Return a XPath like path to this item"
  3170 
  3171     | view views|
  3172 
  3173     selection isNil ifTrue:[ ^ nil ].
  3174     selection isCollection ifTrue:[ 
  3175         selection size ~~ 1 ifTrue:[ ^ nil ].
  3176         view := selection anElement widget.
  3177     ] ifFalse:[ 
  3178         view := selection widget.
  3179     ].
  3180     views := OrderedCollection new.
  3181     [ view notNil ] whileTrue:[ 
  3182         views add: view.
  3183         view := view superView.
  3184     ].
  3185     views removeLast.
  3186     ^ String streamContents:[ :s|
  3187         views reverseDo:[:each |
  3188             s nextPutAll:'/'.
  3189             s nextPutAll: each name asString "storeString".
  3190         ].
  3191     ]
  3192 
  3193     "Created: / 19-05-2014 / 18:15:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
  3194 !
  3195 
  3196 rootItem
  3197     "get the rootItem the event viewer is established on
  3198     "
  3199     ^ listOfItems root
  3200 !
  3201 
  3202 rootItem:anItem
  3203     "set the rootItem the event viewer is established on
  3204     "
  3205     |expanded|
  3206 
  3207     timedUpdateTask := nil.
  3208     self deselect.
  3209 
  3210     lockSema critical:[
  3211         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
  3212                      ifFalse:[ expanded := false ].
  3213 
  3214         self value:nil.
  3215         listOfItems root:anItem.
  3216 
  3217         anItem notNil ifTrue:[
  3218             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
  3219             timedUpdateTask name:'Update'.
  3220             timedUpdateTask resume.
  3221         ].
  3222     ].
  3223 
  3224     (expanded and:[anItem notNil]) ifTrue:[
  3225         anItem expand
  3226     ].
  3227     ^ anItem
  3228 !
  3229 
  3230 rootView
  3231     "get the top widget the event viewer is established on, a View
  3232     "
  3233     ^ listOfItems rootView
  3234 ! !
  3235 
  3236 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
  3237 
  3238 beforeSelectionChangedAction
  3239     "none argument action which is called before
  3240      the selection changed
  3241     "
  3242     ^ beforeSelectionChangedAction
  3243 !
  3244 
  3245 beforeSelectionChangedAction:aNoneArgBlock
  3246     "none argument action which is called before
  3247      the selection changed
  3248     "
  3249     beforeSelectionChangedAction := aNoneArgBlock.
  3250 !
  3251 
  3252 inputEventAction
  3253     "called for each input event; the argument to the action is the WindowEvent
  3254     "
  3255     ^ inputEventAction
  3256 !
  3257 
  3258 inputEventAction:aOneArgActionTheEvent
  3259     "called for each input event; the argument to the action is the WindowEvent
  3260     "
  3261     inputEventAction := aOneArgActionTheEvent.
  3262 !
  3263 
  3264 mappedViewAction
  3265     "called for a new mapped view which can not be found
  3266      in the current item list
  3267     "
  3268     ^ mappedViewAction
  3269 !
  3270 
  3271 mappedViewAction:aOneArgBlockTheMappedView
  3272     "called for a new mapped view which can not be found
  3273      in the current item list
  3274     "
  3275     mappedViewAction := aOneArgBlockTheMappedView
  3276 ! !
  3277 
  3278 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
  3279 
  3280 iconAt:aKey ifNonePut:aNoneArgBlock
  3281     |icon view|
  3282 
  3283     icon := icons at:aKey ifAbsent:nil.
  3284     icon notNil ifTrue:[^ icon].
  3285 
  3286     icon := aNoneArgBlock value.
  3287     icon isNil ifTrue:[^ nil].
  3288 
  3289     view := self rootView.
  3290     view isNil ifTrue:[^ icon].
  3291 
  3292     icon := icon copy onDevice:(view device).
  3293     icon isImage ifTrue:[
  3294         icon clearMaskedPixels.
  3295     ].
  3296     icons at:aKey put:icon.
  3297     ^ icon
  3298 ! !
  3299 
  3300 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
  3301 
  3302 signalHiddenLevel
  3303     "show the selection if signaled; increments hiddenLevel
  3304      see: #waitHiddenLevel
  3305     "
  3306     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
  3307         hiddenLevel := 0.
  3308         self invalidateSelection.
  3309     ].
  3310 !
  3311 
  3312 waitHiddenLevel
  3313     "hide the selection until signaled; increments hiddenLevel
  3314      see: #signalHiddenLevel
  3315     "
  3316     self redrawUnselected:selection andLock:true
  3317 !
  3318 
  3319 withSelectionHiddenDo:aNoneArgumentBlock
  3320     "apply block with selection hidden
  3321     "
  3322 
  3323     [   self waitHiddenLevel.
  3324 
  3325         aNoneArgumentBlock value
  3326 
  3327     ] valueNowOrOnUnwindDo:[
  3328         self signalHiddenLevel.
  3329     ].
  3330 ! !
  3331 
  3332 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
  3333 
  3334 hasTargetWidgetChannel
  3335     "answer the channel which is set to true if a target widget exists"
  3336 
  3337     ^ hasTargetWidgetChannel
  3338 !
  3339 
  3340 listOfItems
  3341     "hiearchical list build from existing items"
  3342 
  3343     ^ listOfItems
  3344 !
  3345 
  3346 selectOnClickHolder
  3347     "boolean holder, which indicates whether the selection will change on click
  3348     "
  3349     ^ selectOnClickHolder
  3350 !
  3351 
  3352 testModeChannel
  3353     "answer a boolean channel which describes the behaviour how to process
  3354      events on the target view.
  3355 
  3356      false: all input events are eaten and the selection is shown on the target view.
  3357      true:  no  input events are eaten and no  selection is shown on the target view."
  3358 
  3359     ^ testModeChannel
  3360 ! !
  3361 
  3362 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
  3363 
  3364 targetWidgetChanged
  3365     hasTargetWidgetChannel value:(self rootItem notNil).
  3366 !
  3367 
  3368 timedUpdateTaskCycle
  3369     |view myTaskId|
  3370 
  3371     myTaskId := timedUpdateTask.
  3372 
  3373     listOfItems root notNil ifTrue:[
  3374         view := listOfItems root widget.
  3375     ].
  3376 
  3377     [ view notNil ] whileTrue:[
  3378         Delay waitForSeconds:0.5.
  3379         
  3380         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
  3381             view := nil.
  3382         ] ifTrue:[
  3383             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
  3384                 view sensor pushUserEvent:#updateChildren for:self.
  3385             ].
  3386         ].
  3387     ].
  3388     timedUpdateTask == myTaskId ifTrue:[
  3389         timedUpdateTask := nil.
  3390         listOfItems root:nil.
  3391     ].
  3392 !
  3393 
  3394 update:something with:someArgument from:aModel
  3395 
  3396     aModel == testModeChannel ifTrue:[
  3397         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
  3398             testModeChannel value ifTrue:[
  3399                 self redrawUnselected:selection andLock:false checkTestMode:false.
  3400             ] ifFalse:[
  3401                 self invalidateSelection.
  3402             ].
  3403         ].
  3404         ^ self
  3405     ].
  3406     super update:something with:someArgument from:aModel.
  3407 !
  3408 
  3409 updateChildren
  3410     |rootItem|
  3411 
  3412     rootItem := listOfItems root.
  3413     rootItem isNil ifTrue:[^ self].
  3414 
  3415     rootItem exists ifFalse:[
  3416         listOfItems root:nil.
  3417     ] ifTrue:[
  3418         rootItem updateChildren.
  3419     ].
  3420 ! !
  3421 
  3422 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
  3423 
  3424 processEvent:anEvent
  3425     "catch and process all WindowEvents for the rootComponent and its contained
  3426      widgets; redraw selection in case of damage...
  3427      return true, if the event was eaten"
  3428 
  3429     |evView item rootView testMode|
  3430 
  3431     catchEvents ifFalse:[^ false].
  3432 
  3433     evView := anEvent view.
  3434     evView isNil ifTrue:[
  3435         (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
  3436             ^ false
  3437         ].
  3438         anEvent value.
  3439         ^ true.
  3440     ].
  3441     rootView := listOfItems rootView.
  3442     rootView isNil ifTrue:[ ^ false ].
  3443 
  3444     anEvent isConfigureEvent ifTrue:[
  3445         hiddenLevel == 0 ifTrue:[
  3446             self redrawUnselected:selection andLock:false.
  3447         ].
  3448         ^ false
  3449     ].
  3450 
  3451     "/ check whether view is contained within the rootView
  3452     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
  3453         ^ false
  3454     ].
  3455 
  3456     anEvent isInputEvent ifFalse:[
  3457         anEvent isDamage ifTrue:[
  3458             hiddenLevel == 0 ifTrue:[self invalidateSelection].
  3459             ^ false
  3460         ].
  3461 
  3462         anEvent isMapEvent ifTrue:[
  3463             mappedViewAction notNil ifTrue:[
  3464                 item := listOfItems recursiveDetect:[:el| el widget == evView].
  3465                 item isNil ifTrue:[ mappedViewAction value:evView ]
  3466             ].
  3467             ^ false
  3468         ].
  3469 
  3470         anEvent type == #terminate ifTrue:[
  3471             item := listOfItems recursiveDetect:[:el| el widget == evView].
  3472             item notNil ifTrue:[ self processTerminateForItem:item ].
  3473             ^ false
  3474         ].
  3475         ^ false
  3476     ].
  3477     testMode := testModeChannel value.
  3478 
  3479     anEvent isFocusEvent ifTrue:[
  3480         evView == rootView ifTrue:[
  3481             self invalidateSelection
  3482         ].
  3483         ^ testMode not.
  3484     ].
  3485     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
  3486 
  3487     testMode ifFalse:[
  3488         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
  3489     ] ifTrue:[
  3490         anEvent isButtonPressEvent ifTrue:[
  3491             selectOnClickHolder value ifTrue:[
  3492                 self selectItem:(listOfItems detectItemRespondsToView:evView).
  3493             ].
  3494         ]
  3495     ].
  3496 
  3497     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
  3498         hiddenLevel := 1.
  3499         self signalHiddenLevel.
  3500     ].
  3501 
  3502     ^ testMode not
  3503 !
  3504 
  3505 processTerminateForItem:anItem
  3506     "received terminate for an item
  3507     "
  3508     anItem remove.
  3509 ! !
  3510 
  3511 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
  3512 
  3513 initialize
  3514     "setup the default attributes
  3515     "
  3516     super initialize.
  3517 
  3518     hiddenLevel           := 0.
  3519     lockSema              := RecursionLock new.
  3520     listOfItems           := ItemList new on:self.
  3521     selectedSuperItems    := #().
  3522     icons                 := IdentityDictionary new.
  3523     catchEvents           := true.
  3524 
  3525     hasTargetWidgetChannel := false asValue.
  3526     selectOnClickHolder    := true asValue.
  3527 
  3528     testModeChannel := false asValue.
  3529     testModeChannel addDependent:self.
  3530 ! !
  3531 
  3532 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
  3533 
  3534 invalidateSelection
  3535     "invalidate the current selection
  3536     "
  3537     |topView|
  3538 
  3539     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3540 
  3541     (     hiddenLevel == 0
  3542      and:[selection notNil
  3543      and:[(topView := listOfItems rootView) notNil
  3544      and:[topView shown]]]
  3545     ) ifTrue:[
  3546         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
  3547     ]
  3548 !
  3549 
  3550 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
  3551     "repair all views and contained views, which intersects the damage.
  3552      !!!! all damages repaired are removed from the list of damages !!!!
  3553     "
  3554     |color relOrg damage subViews repaired
  3555      bwWidth    "{ Class:SmallInteger }"
  3556      x          "{ Class:SmallInteger }"
  3557      y          "{ Class:SmallInteger }"
  3558      w          "{ Class:SmallInteger }"
  3559      h          "{ Class:SmallInteger }"
  3560      relOrgX    "{ Class:SmallInteger }"
  3561      relOrgY    "{ Class:SmallInteger }"
  3562      width      "{ Class:SmallInteger }"
  3563      height     "{ Class:SmallInteger }"
  3564      size       "{ Class:SmallInteger }"
  3565     |
  3566     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
  3567 
  3568     subViews := aView subViews.
  3569 
  3570     subViews size ~~ 0 ifTrue:[
  3571         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
  3572         theDamages isEmpty ifTrue:[ ^ self ].
  3573     ].
  3574 
  3575     relOrg  := aView originRelativeTo:aRootView.
  3576     bwWidth := aView borderWidth.
  3577     size    := theDamages size.
  3578 
  3579     "/ compute relative origin starting from border left@top
  3580     relOrgX := relOrg x - bwWidth.
  3581     relOrgY := relOrg y - bwWidth.
  3582     width   := aView width  + bwWidth + bwWidth.
  3583     height  := aView height + bwWidth + bwWidth.
  3584 
  3585     size to:1 by:-1 do:[:anIndex|
  3586         repaired := damage := theDamages at:anIndex.
  3587 
  3588         "/ compute the rectangle into the view
  3589         y := damage top  - relOrgY.
  3590         x := damage left - relOrgX.
  3591         w := damage width.
  3592         h := damage height.
  3593 
  3594         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
  3595         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
  3596         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
  3597         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
  3598 
  3599         (w > 0 and:[h > 0]) ifTrue:[
  3600             bwWidth ~~ 0 ifTrue:[
  3601                 color isNil ifTrue:[
  3602                     "/ must force redraw of border
  3603                     color := aView borderColor.
  3604                     aView borderColor:(Color colorId:1).
  3605                     aView borderColor:color.
  3606                 ].
  3607                 w := w - bwWidth.
  3608                 h := h - bwWidth.
  3609 
  3610                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
  3611                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
  3612 
  3613                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
  3614             ].
  3615 
  3616             w > 0 ifTrue:[
  3617                 aView clearRectangleX:x y:y width:w height:h.
  3618                 aView exposeX:x y:y width:w height:h
  3619             ].
  3620             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
  3621         ]
  3622     ].
  3623 !
  3624 
  3625 redrawSelection
  3626     "redraw all items selected
  3627     "
  3628     |topView size|
  3629 
  3630     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3631 
  3632     (     hiddenLevel == 0
  3633      and:[(size := selection size) > 0
  3634      and:[(topView := listOfItems rootView) notNil
  3635      and:[topView shown
  3636      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
  3637     ) ifFalse:[
  3638         ^ self
  3639     ].
  3640 
  3641     lockSema critical:[
  3642         |list|
  3643 
  3644         list := selection.
  3645 
  3646         list size > 0 ifTrue:[
  3647             topView paint:(Color black).
  3648             topView clippedByChildren:false.
  3649 
  3650             list keysAndValuesReverseDo:[:anIndex :anItem|
  3651                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
  3652 
  3653                 anItem handlesDo:[:aRect :what|
  3654                     what isNil ifTrue:[topView displayRectangle:aRect]
  3655                               ifFalse:[topView    fillRectangle:aRect]
  3656                 ]
  3657             ].
  3658             topView clippedByChildren:true.
  3659         ].
  3660     ].
  3661 !
  3662 
  3663 redrawUnselected:aList andLock:doLock
  3664     "redraw all items unselected; if doLock is true, the hiddenLevel
  3665      is incremented and thus the select mechanism is locked.
  3666     "
  3667     self redrawUnselected:aList andLock:doLock checkTestMode:true.
  3668 !
  3669 
  3670 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
  3671     "redraw all items unselected; if doLock is true, the hiddenLevel
  3672      is incremented and thus the select mechanism is locked.
  3673     "
  3674     |rootView damages subViews x y w h|
  3675 
  3676     doLock ifTrue:[
  3677         hiddenLevel := hiddenLevel + 1.
  3678         hiddenLevel ~~ 1 ifTrue:[^ self].
  3679     ] ifFalse:[
  3680         hiddenLevel ~~ 0 ifTrue:[^ self].
  3681     ].
  3682     checkTestMode ifTrue:[
  3683         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3684     ].
  3685 
  3686     (     aList size ~~ 0
  3687      and:[(rootView := listOfItems rootView) notNil
  3688      and:[rootView shown]]
  3689     ) ifFalse:[
  3690         ^ self
  3691     ].
  3692 
  3693     lockSema critical:[
  3694         damages := OrderedCollection new:(8 * aList size).
  3695 
  3696         aList do:[:item|
  3697             item handlesDo:[:handle :what|
  3698                 damages reverseDo:[:el|
  3699                     (el intersects:handle) ifTrue:[
  3700                         damages removeIdentical:el.
  3701 
  3702                         handle left:(handle left   min:el left)
  3703                               right:(handle right  max:el right)
  3704                                 top:(handle top    min:el top)
  3705                              bottom:(handle bottom max:el bottom)
  3706                     ]
  3707                 ].                        
  3708                 damages add:handle
  3709             ]
  3710         ].
  3711 
  3712         damages do:[:el|
  3713             x := el left.
  3714             y := el top.
  3715             w := el width.
  3716             h := el height.
  3717 
  3718             rootView clearRectangleX:x y:y width:w height:h.
  3719             rootView         exposeX:x y:y width:w height:h.
  3720         ].
  3721 
  3722         (subViews := rootView subViews) notNil ifTrue:[
  3723             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
  3724         ].
  3725     ].
  3726 ! !
  3727 
  3728 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
  3729 
  3730 isInTestMode
  3731     "answer false, all input events are eaten and the selection is shown on the target view.
  3732      answer true,  no  input events are eaten and no  selection is shown on the target view."
  3733 
  3734     ^ testModeChannel value
  3735 ! !
  3736 
  3737 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
  3738 
  3739 at:anIndex
  3740     "returns the selected item at an index or nil
  3741     "
  3742     selection notNil ifTrue:[
  3743         ^ selection at:anIndex ifAbsent:nil
  3744     ].
  3745     ^ nil
  3746 !
  3747 
  3748 at:anIndex ifAbsent:aBlock
  3749     "returns the selected item at an index or the result of the block
  3750     "
  3751     selection notNil ifTrue:[
  3752         ^ selection at:anIndex ifAbsent:aBlock
  3753     ].
  3754     ^ aBlock value
  3755 !
  3756 
  3757 first
  3758     "returns the first selected item or nil
  3759     "
  3760     ^ self at:1
  3761 !
  3762 
  3763 last
  3764     "returns the last selected item or nil
  3765     "
  3766     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
  3767 !
  3768 
  3769 selectedItem
  3770     "returns the single selected item or nil (size ~~ 1 nil is returned)
  3771     "
  3772     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
  3773 !
  3774 
  3775 selectedSuperItems
  3776     "returs the list of selected superItems; items selected
  3777      but not contained in another selected item.
  3778     "
  3779     ^ selectedSuperItems
  3780 !
  3781 
  3782 size
  3783     "returns the number of items selected
  3784     "
  3785     ^ selection size
  3786 ! !
  3787 
  3788 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
  3789 
  3790 add:item
  3791     "add an item to the current selection
  3792     "
  3793     |newSelect|
  3794 
  3795     item isNil ifTrue:[^ item].
  3796 
  3797     lockSema critical:[
  3798         selection isNil ifTrue:[
  3799             newSelect := Array with:item.
  3800         ] ifFalse:[
  3801             (self includes:item) ifFalse:[
  3802                 newSelect := selection copyWith:item
  3803             ]
  3804         ].
  3805 
  3806         newSelect size ~~ selection size ifTrue:[
  3807             item makeVisible.
  3808             self value:newSelect
  3809         ]
  3810     ].
  3811     ^ item
  3812 !
  3813 
  3814 addAll:aCollectionOfItems
  3815     "add a collection of items to the current selection
  3816     "
  3817     |newSelect|
  3818 
  3819     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
  3820 
  3821     lockSema critical:[
  3822         selection isNil ifTrue:[
  3823             newSelect := Array withAll:aCollectionOfItems.
  3824         ] ifFalse:[
  3825             newSelect := OrderedCollection withAll:selection.
  3826 
  3827             aCollectionOfItems do:[:el|
  3828                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
  3829             ].
  3830         ].
  3831         self value:newSelect.
  3832     ].
  3833     ^ aCollectionOfItems
  3834 !
  3835 
  3836 deselect
  3837     "clear the selection
  3838     "
  3839     self value:nil.
  3840 !
  3841 
  3842 remove:item
  3843     "remove the item from the current selection
  3844     "
  3845     |newSelect|
  3846 
  3847     item isNil ifTrue:[^ nil].
  3848 
  3849     lockSema critical:[
  3850         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
  3851             selection size == 1 ifTrue:[ newSelect := nil ]
  3852                                ifFalse:[ newSelect := selection copyWithout:item ].
  3853 
  3854             self value:newSelect
  3855         ].
  3856     ].
  3857     ^ item
  3858 !
  3859 
  3860 removeAll
  3861     "clear the selection
  3862     "
  3863     self deselect.
  3864 !
  3865 
  3866 removeAll:loItems
  3867     "remove all items of the collection from the current selection
  3868     "
  3869     |newSelect|
  3870 
  3871     selection   isNil ifTrue:[ ^ loItems ].
  3872     loItems size == 0 ifTrue:[ ^ loItems ].
  3873 
  3874     lockSema critical:[
  3875         selection notNil ifTrue:[
  3876             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
  3877             self value:newSelect.
  3878         ]
  3879     ].
  3880     ^ loItems
  3881 !
  3882 
  3883 selectAll
  3884     "select all items
  3885     "
  3886     |root newSelection|
  3887 
  3888     root := listOfItems root.
  3889 
  3890     root isNil ifTrue:[
  3891         newSelection := nil
  3892     ] ifFalse:[
  3893         newSelection := OrderedCollection new.
  3894         root recursiveDo:[:el| newSelection add:el ].
  3895     ].
  3896     self value:newSelection.
  3897 !
  3898 
  3899 selectItem:anItem
  3900     "set the current selection to the item
  3901     "
  3902     self value:anItem
  3903 !
  3904 
  3905 selectRootItem
  3906     "set the current selection to the root item
  3907     "
  3908     self value:(self rootItem).
  3909 !
  3910 
  3911 selectedItem:anItem
  3912     "set the current selection to the item
  3913     "
  3914     self selectItem:anItem.
  3915 !
  3916 
  3917 toggleSelectItem:anItem
  3918     "toggle selection-state of the item; add or remove the item from the
  3919      current selection.
  3920     "
  3921     anItem notNil ifTrue:[
  3922         (self includes:anItem) ifTrue:[self remove:anItem]
  3923                               ifFalse:[self add:anItem]
  3924     ].
  3925     ^ anItem
  3926 ! !
  3927 
  3928 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
  3929 
  3930 collect:aBlock
  3931     "for each element in the selection, evaluate the argument, aBlock
  3932      and return a new collection with the results
  3933     "
  3934     |res|
  3935 
  3936     res := OrderedCollection new.
  3937     self do:[:el| res add:(aBlock value:el)].
  3938   ^ res
  3939 !
  3940 
  3941 do:aOneArgBlock
  3942     "evaluate the argument, aBlock for each item in the selection
  3943     "
  3944     |cashedSelection|
  3945 
  3946     cashedSelection := selection.
  3947     cashedSelection isNil ifTrue:[^ nil].
  3948   ^ cashedSelection do:aOneArgBlock
  3949 !
  3950 
  3951 from:start do:aOneArgBlock
  3952     "evaluate the argument, aBlock for the items starting at index start
  3953     "
  3954     |cashedSelection|
  3955 
  3956     cashedSelection := selection.
  3957     cashedSelection isNil ifTrue:[^ nil].
  3958   ^ cashedSelection from:start do:aOneArgBlock
  3959 !
  3960 
  3961 from:start to:stop do:aOneArgBlock
  3962     "evaluate the argument, aBlock for the items with index start to
  3963      stop in the selection.
  3964     "
  3965     |cashedSelection|
  3966 
  3967     cashedSelection := selection.
  3968     cashedSelection isNil ifTrue:[^ nil].
  3969   ^ cashedSelection from:start to:stop do:aOneArgBlock
  3970 !
  3971 
  3972 reverseDo:aOneArgBlock
  3973     "evaluate the argument, aBlock for each item in the selection
  3974     "
  3975     |cashedSelection|
  3976 
  3977     cashedSelection := selection.
  3978     cashedSelection isNil ifTrue:[^ nil].
  3979   ^ cashedSelection reverseDo:aOneArgBlock
  3980 !
  3981 
  3982 select:aBlock
  3983     "return a new collection with all elements from the selection, for which
  3984      the argument aBlock evaluates to true.
  3985     "
  3986     |res|
  3987 
  3988     res := OrderedCollection new.
  3989     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
  3990   ^ res
  3991 ! !
  3992 
  3993 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
  3994 
  3995 changed:aParameter with:oldSelection
  3996     "update the visibility staus of the current selection
  3997     "
  3998     |unselected rootView rootItem selSize|
  3999 
  4000     selSize := selection size.
  4001 
  4002     selSize == 0 ifTrue:[
  4003         selectedSuperItems := #().
  4004     ] ifFalse:[
  4005         selSize == 1 ifTrue:[
  4006             selectedSuperItems := Array with:(selection at:1).
  4007         ] ifFalse:[
  4008             rootItem := listOfItems root.
  4009 
  4010             (selection includesIdentical:rootItem) ifTrue:[
  4011                 selectedSuperItems := Array with:rootItem.
  4012             ] ifFalse:[
  4013                 selectedSuperItems := OrderedCollection new:selSize.
  4014 
  4015                 selection do:[:anItem|
  4016                     anItem parentsDetect:[:el| selection includesIdentical:el ]
  4017                                   ifNone:[ selectedSuperItems add:anItem ].
  4018                 ].
  4019             ]
  4020         ]
  4021     ].
  4022 
  4023     (     hiddenLevel == 0
  4024      and:[(rootView := listOfItems rootView) notNil
  4025      and:[rootView shown]]
  4026     ) ifTrue:[
  4027         selSize == 0 ifTrue:[
  4028             "/ must redraw the old selection unselected
  4029             self redrawUnselected:oldSelection andLock:false
  4030         ] ifFalse:[
  4031             self invalidateSelection.
  4032 
  4033             oldSelection size ~~ 0 ifTrue:[
  4034                 "/ must redraw all elements no longer in the selection
  4035                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
  4036                 self redrawUnselected:unselected andLock:false.
  4037             ]
  4038         ]
  4039     ].
  4040     super changed:aParameter with:oldSelection.
  4041 !
  4042 
  4043 setValue:aNewSelection 
  4044     "set the selection without notifying
  4045     "
  4046     |newSelect idx|
  4047 
  4048     newSelect := nil.
  4049 
  4050     aNewSelection notNil ifTrue:[
  4051         lockSema critical:[
  4052             aNewSelection isCollection ifFalse:[
  4053                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
  4054                     newSelect := selection
  4055                 ] ifFalse:[
  4056                     newSelect := Array with:aNewSelection.
  4057                 ]
  4058             ] ifTrue:[
  4059                 aNewSelection notEmpty ifTrue:[
  4060                     aNewSelection size ~~ selection size ifTrue:[
  4061                         newSelect := aNewSelection copy.
  4062                     ] ifFalse:[
  4063                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
  4064 
  4065                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
  4066                                 ifFalse:[newSelect := selection ].
  4067                     ]
  4068                 ]
  4069             ]
  4070         ].
  4071     ].
  4072     newSelect ~~ selection ifTrue:[
  4073         beforeSelectionChangedAction value.
  4074         selection := newSelect.
  4075         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  4076     ].
  4077 !
  4078 
  4079 triggerValue:aValue
  4080     "set my value & send change notifications to my dependents.
  4081      Send the change message even if the value didn't change.
  4082     "
  4083     |oldSelection|
  4084 
  4085     lockSema critical:[
  4086         oldSelection := selection.
  4087         self setValue:aValue.
  4088         self changed:#value with:oldSelection
  4089     ]
  4090 !
  4091 
  4092 value
  4093     "returns the current selection
  4094     "
  4095     ^ selection ? #()
  4096 !
  4097 
  4098 value:aValue
  4099     "change the current selection and send change notifications to my
  4100      dependents if it changed.
  4101     "
  4102     |oldSelection|
  4103 
  4104     lockSema critical:[
  4105         oldSelection := selection.
  4106         self setValue:aValue.
  4107 
  4108         oldSelection == selection ifFalse:[
  4109             self changed:#value with:oldSelection
  4110         ]
  4111     ].
  4112 ! !
  4113 
  4114 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
  4115 
  4116 detect:aBlock
  4117     "evaluate the argument, aBlock for each item in the selection until
  4118      the block returns true; in this case return the element which caused
  4119      the true evaluation.
  4120      If none of the evaluations returns true, an error is raised
  4121     "
  4122     ^ self detect:aBlock ifNone:[self errorNotFound]
  4123 !
  4124 
  4125 detect:aBlock ifNone:exceptionBlock
  4126     "evaluate the argument, aBlock for each item in the selection until the
  4127      block returns true; in this case return the element which caused the
  4128      true evaluation.
  4129      If none of the evaluations returns true, the result of the evaluation
  4130      of the exceptionBlock is returned
  4131     "
  4132     |cashedSelection|
  4133 
  4134     cashedSelection := selection.
  4135     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  4136   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  4137 !
  4138 
  4139 detectLast:aBlock
  4140     "evaluate the argument, aBlock for each item in the selection until
  4141      the block returns true; in this case return the element which caused
  4142      the true evaluation. The items are processed in reverse order.
  4143      If none of the evaluations returns true, an error is raised
  4144     "
  4145     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  4146 !
  4147 
  4148 detectLast:aBlock ifNone:exceptionBlock
  4149     "evaluate the argument, aBlock for each item in the selection until
  4150      the block returns true; in this case return the element which caused
  4151      the true evaluation. The items are processed in reverse order.
  4152      If none of the evaluations returns true, the result of the evaluation
  4153      of the exceptionBlock is returned
  4154     "
  4155     |cashedSelection|
  4156 
  4157     cashedSelection := selection.
  4158     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  4159   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  4160 ! !
  4161 
  4162 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
  4163 
  4164 includes:anItem
  4165     "returns true if the item is in the current selection
  4166     "
  4167     |cashedSelection|
  4168 
  4169     cashedSelection := selection.
  4170     cashedSelection isNil ifTrue:[^ false].
  4171  ^  cashedSelection includesIdentical:anItem
  4172 !
  4173 
  4174 includesAll:aCollection
  4175     "return true, if all items of the collection are included in the current selection
  4176     "
  4177     |cashedSelection|
  4178 
  4179     aCollection size ~~ 0 ifTrue:[
  4180         cashedSelection := selection.
  4181         cashedSelection isNil ifTrue:[ ^ false ].
  4182 
  4183         aCollection do:[:el|
  4184             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  4185         ]
  4186     ].
  4187     ^ true
  4188 !
  4189 
  4190 includesAny:aCollection
  4191     "return true, if the any item of the collection is in the current selection
  4192     "
  4193     |cashedSelection|
  4194 
  4195     aCollection notNil ifTrue:[
  4196         cashedSelection := selection.
  4197 
  4198         cashedSelection notNil ifTrue:[
  4199             aCollection do:[:el|
  4200                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  4201             ]
  4202         ]
  4203     ].
  4204     ^ false
  4205 !
  4206 
  4207 includesIdentical:anItem
  4208     "returns true if the item is in the current selection
  4209     "
  4210     ^ self includes:anItem
  4211 !
  4212 
  4213 isEmpty
  4214     "returns true if the current selection is empty
  4215     "
  4216     ^ selection size == 0
  4217 !
  4218 
  4219 isSelected:anItem
  4220     "returns true if the item is in the current selection
  4221     "
  4222     ^ self includes:anItem
  4223 !
  4224 
  4225 notEmpty
  4226     "returns true if the current selection is not empty
  4227     "
  4228     ^ selection size ~~ 0
  4229 ! !
  4230 
  4231 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
  4232 
  4233 documentation
  4234 "
  4235     Kind of HierarchicalList class which contains all the visible
  4236     ViewTreeItem's and the root, the anchor of the hierarchical list.
  4237 
  4238     [Instance variables:]
  4239         treeModel       <ViewTreeModel>         all events are delegated to
  4240         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  4241 
  4242 
  4243     [author:]
  4244         Claus Atzkern
  4245 
  4246     [see also:]
  4247         HierarchicalList
  4248         ViewTreeModel
  4249         ViewTreeItem
  4250 "
  4251 ! !
  4252 
  4253 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
  4254 
  4255 root:theRoot
  4256     "set the root item; delegate events to my treeModel
  4257     "
  4258     |rootView|
  4259 
  4260     theRoot == root ifTrue:[^ self].
  4261 
  4262     rootView := self rootView.
  4263     super root:theRoot.
  4264 
  4265     rootView notNil ifTrue:[ |wgrp|
  4266         wgrp := rootView windowGroup.
  4267 
  4268         wgrp notNil ifTrue:[
  4269            wgrp removePreEventHook:treeModel.
  4270            wgrp removePostEventHook:self.
  4271         ].
  4272     ].
  4273 
  4274     super root:theRoot.
  4275     rootView := self rootView.
  4276 
  4277     rootView notNil ifTrue:[
  4278         "must setup a task because there might not exist a windowGroup at the moment
  4279         "
  4280         [   |wgrp|
  4281 
  4282             [rootView == self rootView] whileTrue:[
  4283                 wgrp := rootView windowGroup.
  4284                 wgrp notNil ifTrue:[
  4285                     rootView := nil.
  4286                     wgrp addPreEventHook:treeModel.
  4287                     wgrp addPostEventHook:self.
  4288                 ] ifFalse:[
  4289                     Delay waitForMilliseconds:100.
  4290                 ].
  4291             ].
  4292 
  4293         ] forkAt:(Processor userSchedulingPriority + 2).
  4294     ].
  4295     treeModel notNil ifTrue:[
  4296         treeModel targetWidgetChanged.
  4297     ].
  4298     
  4299     ^ root.
  4300 !
  4301 
  4302 rootView
  4303     "returns the widget assigned to the root or nil
  4304     "
  4305     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  4306 !
  4307 
  4308 treeModel
  4309     "returne the treeModel, a ViewTreeModel
  4310     "
  4311     ^ treeModel
  4312 ! !
  4313 
  4314 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
  4315 
  4316 additionalLabelForItem:anItem
  4317     "answer the additional lable for an item or nil"
  4318 
  4319     |widget l applClass applClassName key|
  4320 
  4321     widget := anItem widget.
  4322 
  4323     l := nil.
  4324     showWidgetNames == true ifTrue:[
  4325         l := '"', widget name, '"'
  4326     ].
  4327 
  4328     anItem isApplicationClass ifTrue:[
  4329         applClass := anItem applicationClass.
  4330         applClass notNil ifTrue:[   
  4331             applClassName := '[', applClass name allBold, ']'.
  4332             l := (l isNil ifTrue:[''] ifFalse:[l , ' ']) , applClassName
  4333         ].
  4334     ].
  4335 
  4336     application notNil ifTrue:[
  4337         key := application builder namedComponents keyAtValue:widget ifAbsent:nil.
  4338         key notNil ifTrue:[
  4339             l := l , ' #',key
  4340         ].
  4341     ].
  4342 
  4343     ^ l
  4344 !
  4345 
  4346 showWidgetNames
  4347     "answer true if the additional text is the widget name
  4348      otherwise the name of the application"
  4349 
  4350     ^ showWidgetNames ? true
  4351 !
  4352 
  4353 showWidgetNames:aBoolean
  4354     "set true if the additional text is the widget name
  4355      otherwise the name of the application"
  4356 
  4357     self showWidgetNames == aBoolean ifFalse:[
  4358         showWidgetNames := aBoolean.
  4359 
  4360         root notNil ifTrue:[
  4361             root recursiveAdditionalNameBehaviourChanged.
  4362             self changed.
  4363         ].
  4364     ].
  4365 ! !
  4366 
  4367 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
  4368 
  4369 processEvent:anEvent
  4370     "post process event
  4371     "
  4372     ^ treeModel isInTestMode not
  4373 ! !
  4374 
  4375 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
  4376 
  4377 on:aModel
  4378     "set the model, a ViewTreeModel
  4379     "
  4380     treeModel := aModel.
  4381     showRoot  := true.
  4382     "/ showWidgetNames := false.
  4383     showWidgetNames := true.
  4384 ! !
  4385 
  4386 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
  4387 
  4388 detectItemRespondsToView:aView
  4389     "returns the bottom-most item which contains the view
  4390     "
  4391     |view item topView|
  4392 
  4393     root notNil ifTrue:[
  4394         view    := aView.
  4395         topView := root widget.
  4396 
  4397         [ view notNil ] whileTrue:[
  4398             topView == view ifTrue:[^ root].
  4399             item := root recursiveDetect:[:el| el widget == view ].
  4400             item notNil ifTrue:[^ item].
  4401             view := view superView
  4402         ]
  4403     ].
  4404     ^ nil
  4405 !
  4406 
  4407 recursiveDetect:aOneOrgBlock
  4408     "recursive find the first child, for which evaluation 
  4409      of the block returns true; if none nil is returned
  4410     "
  4411     root notNil ifTrue:[
  4412         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  4413       ^ root recursiveDetect:aOneOrgBlock
  4414     ].
  4415     ^ nil
  4416 ! !
  4417 
  4418 !ViewTreeInspectorApplication class methodsFor:'documentation'!
  4419 
  4420 version
  4421     ^ '$Header$'
  4422 !
  4423 
  4424 version_CVS
  4425     ^ '$Header$'
  4426 ! !
  4427 
  4428 
  4429 ViewTreeInspectorApplication initialize!
  4430 ViewTreeInspectorApplication::ViewTreeItem initialize!