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