Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 11 May 2010 12:54:30 +0200
changeset 2779 10fef360ad85
parent 2770 9322aee00ea0
child 2888 9adfb8a84696
permissions -rw-r--r--
changed: #submenuInterface:

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