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