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