Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 10 Feb 2010 23:10:55 +0100
changeset 2762 0c66aa3bfdff
parent 2759 d9a8fc3f0dc7
child 2770 9322aee00ea0
permissions -rw-r--r--
added:
#doPickView
#selectView:
changed:
#menu
#openInPickMode
#selectFocusView
#toolbarMenu

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