Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Mon, 01 Dec 2014 17:43:38 +0100
changeset 3168 894c517d8696
parent 3167 95025cd0fbce
child 3169 54d9e27b384d
permissions -rw-r--r--
class: Tools::ViewTreeInspectorApplication
added: #doSelectNextElementStartingIn:forWhich:
changed:
#doSelectNextOfApplicationClass:startingIn:
#doSelectNextOfClass:startingIn:

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