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