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