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