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