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