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