Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Thu, 04 Feb 2010 16:48:47 +0100
changeset 2759 d9a8fc3f0dc7
parent 2758 c61fe917957a
child 2762 0c66aa3bfdff
permissions -rw-r--r--
added:
#crossHairIcon
#pickWindowIcon2
changed:
#doPickViews
#toolbarMenu
     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: doPickViews
   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: doPickViews
   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 doPickViews.
   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 focusItem 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     focusItem := model selectedItem.
  1454 
  1455     (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
  1456         ^ self
  1457     ].
  1458     focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
  1459 
  1460     focusItem notNil ifTrue:[
  1461         model selectItem:focusItem.
  1462     ].        
  1463 !
  1464 
  1465 setRootItem:aRootItemOrNil
  1466     |theProcess|
  1467 
  1468     aRootItemOrNil isNil ifTrue:[
  1469         process := nil.
  1470     ] ifFalse:[
  1471         "/ expand tree to level 3
  1472         aRootItemOrNil do:[:aRootChild|
  1473             aRootChild do:[:aSubChild| aSubChild expand ].
  1474             aRootChild expand.
  1475         ].
  1476         aRootItemOrNil expand.
  1477 
  1478         process isNil ifTrue:[
  1479             theProcess := process :=
  1480                 Process for:[   |update testModeChannel|
  1481 
  1482                                 update := false.
  1483                                 testModeChannel := model testModeChannel.
  1484 
  1485                                 [process == theProcess] whileTrue:[
  1486                                     Delay waitForSeconds:0.5.
  1487 
  1488                                     (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
  1489                                         (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
  1490                                             self selectFocusView.
  1491                                         ].
  1492                                         update ifTrue:[
  1493                                             self updateShownStatus.
  1494                                         ].
  1495                                         update := update not.
  1496                                     ].
  1497                                 ].
  1498 
  1499                              ] priority:8.
  1500             theProcess name:'ViewTreeInspector - Follow Focus'.
  1501             theProcess resume.
  1502         ].
  1503     ].
  1504     model rootItem:aRootItemOrNil.
  1505 !
  1506 
  1507 updateShownStatus
  1508     |rootItem min max visState listIdx visY0 visY1 height damage|
  1509 
  1510     rootItem := model rootItem.
  1511     (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
  1512 
  1513     max := 0.
  1514     min := 9999999.
  1515 
  1516     rootItem recursiveEachVisibleItemDo:[:anItem|
  1517         visState := (anItem widget shown).
  1518 
  1519         visState ~~ anItem isDrawnShown ifTrue:[
  1520             anItem isDrawnShown:visState.
  1521             listIdx := treeView identityIndexOf:anItem.
  1522 
  1523             listIdx > 0 ifTrue:[    
  1524                 max := max max:listIdx.
  1525                 min := min min:listIdx.
  1526             ].
  1527         ].
  1528     ].
  1529     max < min ifTrue:[^ self].
  1530     max := max + 1.
  1531 
  1532     visY0  := (treeView yVisibleOfLine:min) max:0.
  1533     visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
  1534     height := visY1 - visY0.
  1535     
  1536     height > 2 ifTrue:[
  1537         treeView shown ifTrue:[
  1538             damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
  1539             treeView invalidateDeviceRectangle:damage repairNow:false.
  1540         ].
  1541     ].
  1542 ! !
  1543 
  1544 !ViewTreeInspectorApplication methodsFor:'selection'!
  1545 
  1546 selectedView
  1547     "answer the selected view or nil"
  1548 
  1549     |item|
  1550 
  1551     item := model selectedItem.
  1552     item notNil ifTrue:[ ^ item widget ].
  1553   ^ nil
  1554 ! !
  1555 
  1556 !ViewTreeInspectorApplication methodsFor:'testing'!
  1557 
  1558 resolveApplicationClassFor:aTreeItem
  1559     aTreeItem isApplicationClass ifTrue:[
  1560        ^ aTreeItem applicationClass
  1561     ].
  1562     ^ nil
  1563 !
  1564 
  1565 selectedComponentHasChildren
  1566     |item|
  1567 
  1568     item := model selectedItem.
  1569     ^ (item notNil and:[item hasChildren])
  1570 ! !
  1571 
  1572 !ViewTreeInspectorApplication methodsFor:'user operations'!
  1573 
  1574 doBrowse:what
  1575     "open browser on:
  1576         #view           browse class
  1577         #model          browse model class
  1578         #application    browse application class
  1579         #controller     browse controller class
  1580     "
  1581     |view inst|
  1582 
  1583     view := self selectedView.
  1584     view isNil ifTrue:[^ self].
  1585 
  1586              what == #view        ifTrue:[ inst := view ]
  1587     ifFalse:[what == #model       ifTrue:[ inst := view model ]
  1588     ifFalse:[what == #application ifTrue:[ inst := view application ]
  1589     ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
  1590     ifFalse:[
  1591         ^ self
  1592     ]]]].
  1593 
  1594     inst notNil ifTrue:[
  1595         inst class browserClass openInClass:(inst class) selector:nil
  1596     ].
  1597 !
  1598 
  1599 doDestroy
  1600     "destroy the current selected view"
  1601 
  1602     |item parent|
  1603 
  1604     item := model selectedItem.
  1605     item isNil ifTrue:[ ^ self].
  1606 
  1607     parent := item parent.
  1608 
  1609     parent isNil ifTrue:[
  1610         "/ the root
  1611         model withSelectionHiddenDo:[item deleteAll].
  1612       ^ self
  1613     ].
  1614 
  1615     model withSelectionHiddenDo:[
  1616         |idx nsel|
  1617 
  1618         idx := parent identityIndexOf:item.
  1619 
  1620         idx == parent size ifTrue:[
  1621             nsel := parent at:(idx - 1) ifAbsent:parent
  1622         ] ifFalse:[
  1623             nsel := parent at:(idx + 1)
  1624         ].
  1625         model setValue:nil.
  1626         item delete.
  1627 
  1628         parent isLayoutContainer ifTrue:[
  1629             parent widget sizeChanged:nil
  1630         ].
  1631         model value:nsel.
  1632     ].
  1633 !
  1634 
  1635 doFlash
  1636     "flash the selected view"
  1637 
  1638     |view|
  1639 
  1640     view := self selectedView.
  1641     view isNil ifTrue:[ ^ self].
  1642 
  1643     view shown ifTrue:[
  1644         model withSelectionHiddenDo:[
  1645             view perform:#flash ifNotUnderstood:nil.
  1646         ].
  1647     ].
  1648 !
  1649 
  1650 doInspect:what
  1651     "open inspector on:
  1652         #view           inspect class
  1653         #group          inspect windowGroup
  1654         #model          inspect model
  1655         #application    inspect application
  1656         #controller     inspect controller
  1657     "
  1658     |inst|
  1659 
  1660     inst := self selectedView.
  1661     inst isNil ifTrue:[^ self].
  1662 
  1663              what == #group       ifTrue:[ inst := inst windowGroup ]
  1664     ifFalse:[what == #model       ifTrue:[ inst := inst model ]
  1665     ifFalse:[what == #application ifTrue:[ inst := inst application ]
  1666     ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
  1667 
  1668     inst notNil ifTrue:[ inst inspect ].
  1669 !
  1670 
  1671 doPickViews
  1672     "pick a window's topView"
  1673 
  1674     |screen window cursor|
  1675 
  1676     self doUnpick.
  1677 
  1678     cursor := Cursor fromImage:(self class crossHairIcon).
  1679 
  1680     screen := Screen current.
  1681     window := screen viewFromPoint:(screen pointFromUserShowing:cursor).
  1682     window isNil ifTrue:[^ self].
  1683 
  1684     window := window topView.
  1685 
  1686     (    window == Screen current rootView
  1687      or:[window == self window topView]
  1688     ) ifTrue:[
  1689         ^ self
  1690     ].
  1691     self setRootItem:(ViewTreeItem buildViewsFrom:window).
  1692 !
  1693 
  1694 doSelectNextOfApplicationClass:aClass startingIn:anItem
  1695     |startItem firstFound searchNext|
  1696 
  1697     startItem  := model last.
  1698     searchNext := startItem notNil.        
  1699     firstFound := nil.
  1700 
  1701     anItem recursiveDo:[:el|
  1702         el == startItem ifTrue:[
  1703             searchNext := false
  1704         ] ifFalse:[
  1705             (self resolveApplicationClassFor:el) == aClass ifTrue:[
  1706                 searchNext ifFalse:[^ model selectItem:el].
  1707 
  1708                 firstFound isNil ifTrue:[
  1709                     firstFound := el
  1710                 ]
  1711             ]
  1712         ]
  1713     ].
  1714     firstFound notNil ifTrue:[
  1715         self window beep.
  1716         model selectItem:firstFound
  1717     ].
  1718 !
  1719 
  1720 doSelectNextOfClass:aClass startingIn:anItem
  1721     |startItem firstFound searchNext|
  1722 
  1723     startItem  := model last.
  1724     searchNext := startItem notNil.        
  1725     firstFound := nil.
  1726 
  1727     anItem recursiveDo:[:el|
  1728         el == startItem ifTrue:[
  1729             searchNext := false
  1730         ] ifFalse:[
  1731             el widget class == aClass ifTrue:[
  1732                 searchNext ifFalse:[^ model selectItem:el].
  1733 
  1734                 firstFound isNil ifTrue:[
  1735                     firstFound := el
  1736                 ]
  1737             ]
  1738         ]
  1739     ].
  1740     firstFound notNil ifTrue:[
  1741         self window beep.
  1742         model selectItem:firstFound
  1743     ].
  1744 !
  1745 
  1746 doUnpick
  1747     "release current picked window and contained subwindows"
  1748 
  1749     self setRootItem:nil.
  1750 !
  1751 
  1752 openDocumentation
  1753     HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
  1754 ! !
  1755 
  1756 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
  1757 
  1758 buildFromList:aList onGC:aMenu
  1759     |tabSpec menu w menuPanel|
  1760 
  1761     w := 0.
  1762     aList do:[:el| w := w max:(el widthOn:aMenu) ].
  1763 
  1764     tabSpec := TabulatorSpecification new.
  1765     tabSpec unit:#pixel.
  1766     tabSpec positions:#(0     1.5 ).
  1767     tabSpec align:#(#left #left).
  1768 
  1769     w := w + 15.
  1770     tabSpec positions:(Array with:0 with:w).
  1771 
  1772     menu := Menu new.
  1773 
  1774     aList do:[:el|
  1775         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
  1776     ].
  1777     menuPanel := MenuPanel menu:menu.
  1778     ^ menuPanel
  1779 ! !
  1780 
  1781 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
  1782 
  1783 separator
  1784     ^ self new
  1785 !
  1786 
  1787 title:aTitle value:aValue
  1788     ^ self title:aTitle value:aValue action:nil
  1789 !
  1790 
  1791 title:aTitle value:aValue action:anAction
  1792     ^ self new title:aTitle value:aValue action:anAction
  1793 ! !
  1794 
  1795 !ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
  1796 
  1797 title
  1798     ^ title
  1799 ! !
  1800 
  1801 !ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
  1802 
  1803 asMenuItemWithTabulatorSpecification:aTabSpec
  1804     |array|
  1805 
  1806     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
  1807 
  1808     array := Array with:(title, ':') with:'------'.
  1809 
  1810     value notNil ifTrue:[
  1811         array at:2 put:(value printString, ' ')
  1812     ].
  1813 
  1814    ^ MenuItem 
  1815         label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
  1816         value:action
  1817 ! !
  1818 
  1819 !ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
  1820 
  1821 title:aTitle value:aValue action:anAction
  1822     "test for separator
  1823     "
  1824     title  := aTitle withoutSeparators.
  1825     action := anAction.
  1826 
  1827     aValue notNil ifTrue:[
  1828         value := aValue printString.
  1829 
  1830         value size > 70 ifTrue:[
  1831             value := value copyFrom:1 to:70.
  1832             value := value, '...'
  1833         ]
  1834     ].
  1835 ! !
  1836 
  1837 !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
  1838 
  1839 isSeparator
  1840     ^ title isNil
  1841 !
  1842 
  1843 widthOn:aGC
  1844     title isNil ifTrue:[^ 5].  "/ separator
  1845     ^ title widthOn:aGC
  1846 ! !
  1847 
  1848 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
  1849 
  1850 buildViewsFrom:aView
  1851     "build the items starting from a source view;
  1852      returns the anhor.
  1853     "
  1854     |item subViews subItems|
  1855 
  1856     aView isNil ifTrue:[^ nil].
  1857 
  1858     item     := self forView:aView.
  1859     subViews := aView subViews.
  1860 
  1861     subViews notEmptyOrNil ifTrue:[
  1862         subItems := OrderedCollection new.
  1863         subViews do:[:aSubView|
  1864             subItems add:(self buildViewsFrom:aSubView).
  1865         ].
  1866         item children:subItems.
  1867     ].
  1868     ^ item
  1869 ! !
  1870 
  1871 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
  1872 
  1873 documentation
  1874 "
  1875     ViewTreeItems represants a pickable object within a ViewTreeModel.
  1876     The class is used to build up the hierarchical tree.
  1877 
  1878     [Instance variables:]
  1879         widget        <View>            the widget represented by the item
  1880         spec          <UISpecification> the UISpecification or nil
  1881 
  1882     [Class variables:]
  1883         HandleExtent  <Point>           keeps the extent of a handle
  1884 
  1885 
  1886     [author:]
  1887         Claus Atzkern
  1888 
  1889     [see also:]
  1890         HierarchicalItem
  1891         ViewTreeModel
  1892 "
  1893 !
  1894 
  1895 version
  1896     ^ '$Header$'
  1897 ! !
  1898 
  1899 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
  1900 
  1901 initialize
  1902     "set the extent of the Handle
  1903     "
  1904     HandleExtent := 6@6.
  1905 ! !
  1906 
  1907 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
  1908 
  1909 forView:aView
  1910     |item|
  1911 
  1912     item := self basicNew initialize.
  1913     item forView:aView.
  1914   ^ item
  1915 !
  1916 
  1917 new
  1918     self error:'not allowed'.
  1919   ^ nil
  1920 !
  1921 
  1922 on:aView withSpec:aSpec
  1923     |item|
  1924 
  1925     item := self basicNew initialize.
  1926     item on:aView withSpec:aSpec.
  1927   ^ item
  1928 ! !
  1929 
  1930 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
  1931 
  1932 applicationClass
  1933     |appl|
  1934 
  1935     widget notNil ifTrue:[
  1936         appl := widget application.
  1937         appl notNil ifTrue:[^ appl class ].
  1938     ].
  1939     ^ nil
  1940 !
  1941 
  1942 isDrawnShown
  1943     "returns true if the last display operations was done during the widget was shown
  1944     "
  1945     ^ isDrawnShown
  1946 !
  1947 
  1948 isDrawnShown:aBoolean
  1949     isDrawnShown := aBoolean.
  1950 !
  1951 
  1952 rootView
  1953     "returns the widget assigned to the root or nil
  1954     "
  1955     ^ parent rootView
  1956 !
  1957 
  1958 specClass
  1959     "returns the spec-class assigned to the item
  1960     "
  1961     ^ widget specClass
  1962 !
  1963 
  1964 treeModel
  1965     "returns the assigned treeModel, an instance of ViewTreeModel
  1966     "
  1967     ^ parent treeModel
  1968 !
  1969 
  1970 widget
  1971     "returns the widget assigned to the item
  1972     "
  1973     ^ widget
  1974 ! !
  1975 
  1976 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
  1977 
  1978 boundsRelativeToRoot
  1979     "returns the bounds relative to the root widget
  1980     "
  1981     ^ self originRelativeToRoot extent:(widget extent)
  1982 !
  1983 
  1984 cornerRelativeToRoot
  1985     "returns the corner relative to the root widget
  1986     "
  1987     ^ self originRelativeToRoot + (widget extent)
  1988 !
  1989 
  1990 extent
  1991     "returns the extent of the widget
  1992     "
  1993     ^ widget extent
  1994 !
  1995 
  1996 layoutType
  1997     "returns the type of layout assigned to the wiget; nil if the
  1998      superView cannot resize its sub widgets
  1999     "
  2000     |layout specClass superView|
  2001 
  2002     (superView := widget superView) isNil ifTrue:[
  2003         ^ #Extent
  2004     ].
  2005         
  2006     specClass := superView specClass.
  2007 
  2008     (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
  2009         ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
  2010     ].
  2011 
  2012     (layout := widget geometryLayout) isNil ifTrue:[
  2013         ^ #Extent
  2014     ].
  2015 
  2016     layout isLayout ifTrue:[
  2017         layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
  2018         layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
  2019         layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
  2020     ] ifFalse:[
  2021         layout isRectangle          ifTrue:[ ^ #Rectangle ].
  2022         layout isPoint              ifTrue:[ ^ #Point ].
  2023 
  2024     ].
  2025     Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2026   ^ nil
  2027 !
  2028 
  2029 originRelativeToRoot
  2030     "returns the origin relative to the root widget
  2031     "
  2032     ^ widget originRelativeTo:(self rootView)
  2033 ! !
  2034 
  2035 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
  2036 
  2037 children
  2038     "redefined: optimize
  2039     "
  2040     ^ children
  2041 !
  2042 
  2043 hasChildren
  2044     |subViews list item|
  2045 
  2046     children size ~~ 0 ifTrue:[
  2047         ^ true
  2048     ].
  2049     isExpanded := false.
  2050     subViews   := widget subViews.
  2051 
  2052     subViews size == 0 ifTrue:[^ false].
  2053 
  2054     list := OrderedCollection new.
  2055 
  2056     subViews do:[:aSubView|
  2057         item := self class buildViewsFrom:aSubView.
  2058         item parent:self.
  2059         list add:item.
  2060     ].
  2061     children := list.
  2062     ^ true
  2063 !
  2064 
  2065 size
  2066     "redefined: returns list of children
  2067     "
  2068     ^ children size
  2069 ! !
  2070 
  2071 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
  2072 
  2073 additionalLabelForItem:anItem
  2074     "answer an additional item for an Item or nil"
  2075 
  2076     parent notNil ifTrue:[
  2077         ^ parent additionalLabelForItem:anItem
  2078     ].
  2079     ^ nil
  2080 !
  2081 
  2082 displayIcon:anIcon atX:x y:y on:aGC
  2083     |x0 y0 y1 w|
  2084 
  2085     super displayIcon:anIcon atX:x y:y on:aGC.
  2086 
  2087     self exists ifFalse:[
  2088         aGC paint:(Color red).
  2089 
  2090         y0 := y + 1.
  2091         y1 := y + anIcon height - 2.
  2092 
  2093         x0 := x - 1.
  2094         w  := anIcon width.
  2095 
  2096         2 timesRepeat:[
  2097             aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
  2098             aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
  2099             x0 := x0 + 1.
  2100         ].
  2101     ].
  2102 !
  2103 
  2104 displayOn:aGC x:x y:y h:h
  2105     |labelHeight additionalName label isValidAndShown|
  2106 
  2107     label := self label.
  2108     label isEmptyOrNil ifTrue:[^ self].
  2109 
  2110     widget id isNil ifTrue:[
  2111         isDrawnShown := false.
  2112 
  2113         self exists ifFalse:[
  2114             xOffsetAdditionalName := nil.
  2115         ].
  2116         isValidAndShown := false.
  2117     ] ifFalse:[
  2118         isValidAndShown := widget shown.
  2119     ].
  2120     isValidAndShown ifFalse:[
  2121         label := Text string:label emphasis:#italic
  2122     ].
  2123 
  2124     labelHeight := self heightOn:aGC.
  2125     self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
  2126 
  2127     xOffsetAdditionalName notNil ifTrue:[
  2128         additionalName := self additionalLabelForItem:self.
  2129 
  2130         additionalName notNil ifTrue:[
  2131             self displayLabel:additionalName
  2132                             h:labelHeight on:aGC
  2133                             x:(x + xOffsetAdditionalName)
  2134                             y:y
  2135                             h:h.
  2136         ] ifFalse:[
  2137             xOffsetAdditionalName := nil.
  2138         ].
  2139     ].
  2140 !
  2141 
  2142 recursiveAdditionalNameBehaviourChanged
  2143     width := xOffsetAdditionalName := nil.
  2144 
  2145     children notNil ifTrue:[
  2146         children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
  2147     ].
  2148 !
  2149 
  2150 widthOn:aGC
  2151     "return the width of the receiver, if it is to be displayed on aGC
  2152     "
  2153     |additionalName|
  2154 
  2155     width isNil ifTrue:[
  2156         width := self widthOf:(self label) on:aGC.
  2157         width := width + 2.
  2158 
  2159         additionalName := self additionalLabelForItem:self.
  2160 
  2161         additionalName notNil ifTrue:[
  2162             xOffsetAdditionalName := width + 10.
  2163             width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
  2164             width := width + 2.
  2165         ] ifFalse:[
  2166             xOffsetAdditionalName := nil.
  2167         ].
  2168     ].
  2169     ^ width
  2170 ! !
  2171 
  2172 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
  2173 
  2174 handlesDo:aTwoArgAction
  2175     "evaluate the two arg block on each handle; the arguments to the block is
  2176      the rectangle relative to the rootView and the handle type which is
  2177      set to nil if not resizeable.
  2178 
  2179      TYPES:     type    position( X - Y )
  2180                 -------------------------        
  2181                 #LT     Left   - Top
  2182                 #LC     Left   - Center
  2183                 #LB     Left   - Bottom
  2184                 #CT     Center - Top
  2185                 #CB     Center - Bottom
  2186                 #RT     Right  - Top
  2187                 #RC     Right  - Center
  2188                 #RB     Right  - Bottom
  2189 
  2190                 nil     ** handle not pickable **
  2191     "
  2192     |type relOrg relCrn maxExt rootView w h
  2193      xL    "{ Class:SmallInteger }"
  2194      xC    "{ Class:SmallInteger }"
  2195      xR    "{ Class:SmallInteger }"
  2196      yT    "{ Class:SmallInteger }"
  2197      yC    "{ Class:SmallInteger }"
  2198      yB    "{ Class:SmallInteger }"
  2199     |
  2200     rootView := self rootView.
  2201     relOrg   := widget originRelativeTo:rootView.
  2202     relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
  2203 
  2204     relOrg   := relOrg - (HandleExtent // 2).
  2205     relCrn   := relOrg + widget extent.
  2206     maxExt   := rootView extent - HandleExtent.
  2207 
  2208     xL := relOrg x max:0.
  2209     xR := relCrn x min:(maxExt x).
  2210     xC := xR + xL // 2.
  2211 
  2212     yT := relOrg y max:0.
  2213     yB := relCrn y min:(maxExt y).
  2214     yC := yB + yT // 2.
  2215 
  2216     type := self layoutType.
  2217     w   := HandleExtent x.
  2218     h   := HandleExtent y.
  2219 
  2220     (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
  2221         aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
  2222         aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
  2223         aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
  2224         aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
  2225         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2226         aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
  2227         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2228         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2229       ^ self
  2230     ].
  2231 
  2232     aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
  2233     aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
  2234     aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
  2235 
  2236     type == #Extent ifTrue:[
  2237         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2238         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2239         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2240       ^ self
  2241     ].
  2242     aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
  2243 !
  2244 
  2245 recursiveEachVisibleItemDo:anOneArgBlock
  2246     "recursive evaluate the block on each child which is visible
  2247     "
  2248     (isExpanded and:[children size > 0]) ifTrue:[
  2249         children do:[:aChild|
  2250             anOneArgBlock value:aChild.
  2251             aChild recursiveEachVisibleItemDo:anOneArgBlock.
  2252         ]
  2253     ].
  2254 !
  2255 
  2256 subViewsDo:aOneArgBlock
  2257     "evaluate aBlock for all subviews other than InputView's   
  2258     "
  2259     |subViews|
  2260 
  2261     subViews := widget subViews.
  2262 
  2263     subViews notNil ifTrue:[
  2264         subViews do:aOneArgBlock
  2265     ].
  2266 ! !
  2267 
  2268 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
  2269 
  2270 forView:aView
  2271     widget := aView.
  2272 !
  2273 
  2274 initialize
  2275     "setup default attributes
  2276     "
  2277     super initialize.
  2278     isDrawnShown := false.
  2279     isExpanded   := false.
  2280     children     := OrderedCollection new.
  2281 ! !
  2282 
  2283 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
  2284 
  2285 delete
  2286     "delete self and all contained items; the assigned views are destroyed
  2287      in case of rootView, only the children are deleted
  2288     "
  2289     parent isHierarchicalItem ifTrue:[
  2290         self criticalDo:[
  2291             parent remove:self.
  2292             widget destroy.
  2293         ]
  2294     ] ifFalse:[
  2295         self deleteAll
  2296     ].
  2297 !
  2298 
  2299 deleteAll
  2300     "delete all contained items; the assigned views are destroyed
  2301     "
  2302     children size == 0 ifTrue:[^ self].
  2303 
  2304     self criticalDo:[
  2305         self nonCriticalDo:[:el| el widget destroy ].
  2306         self removeAll
  2307     ].
  2308 ! !
  2309 
  2310 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
  2311 
  2312 asLayoutFrame
  2313     "convert the layout of the widget to a LayoutFrame;
  2314     "
  2315     |extent layout newLyt lftFrc lftOff topFrc topOff|
  2316 
  2317     layout := widget geometryLayout.
  2318 
  2319     layout isNil ifTrue:[
  2320         ^ widget bounds asLayout
  2321     ].
  2322 
  2323     layout isLayout ifFalse:[
  2324         layout isRectangle ifTrue:[
  2325             ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
  2326                            topOffset:(layout top) bottomOffset:(layout bottom)
  2327         ].
  2328         layout isPoint ifTrue:[
  2329             extent := widget extent.
  2330           ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
  2331                          topOffset:(layout y) bottomOffset:(layout y + extent y)
  2332         ].
  2333 
  2334         Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2335       ^ nil
  2336     ].
  2337 
  2338     layout isLayoutFrame ifTrue:[ ^ layout copy ].    
  2339 
  2340     lftFrc := layout leftFraction.
  2341     lftOff := layout leftOffset.
  2342     topFrc := layout topFraction.
  2343     topOff := layout topOffset.
  2344     extent := widget extent.
  2345 
  2346     newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
  2347                          rightFraction:lftFrc offset:(lftOff + extent x)
  2348                            topFraction:topFrc offset:topOff
  2349                         bottomFraction:topFrc offset:(topOff + extent y).
  2350 
  2351     (      layout isAlignmentOrigin
  2352      and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
  2353     ) ifTrue:[
  2354         |svRc prBd dlta|
  2355 
  2356         svRc := widget superView viewRectangle.
  2357         prBd := widget preferredBounds.
  2358 
  2359         dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
  2360                  - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
  2361                 ) rounded.
  2362 
  2363         newLyt   leftOffset:(lftOff + dlta x).
  2364         newLyt  rightOffset:(lftOff + extent x + dlta x).
  2365         newLyt    topOffset:(topOff + dlta y).
  2366         newLyt bottomOffset:(topOff + extent y + dlta y).
  2367     ].
  2368     ^ newLyt
  2369 !
  2370 
  2371 moveLeft:l top:t
  2372     "move the widget n pixele left and right
  2373     "
  2374     |layout|
  2375 
  2376     self isMoveable ifFalse:[ ^ self ].
  2377 
  2378     (layout := widget geometryLayout) isNil ifTrue:[
  2379         "Extent"
  2380         widget origin:(widget origin + (l@t)).
  2381       ^ self
  2382     ].
  2383 
  2384     layout := layout copy.
  2385 
  2386     layout isLayout ifTrue:[
  2387         layout leftOffset:(layout leftOffset + l)
  2388                 topOffset:(layout topOffset  + t).
  2389 
  2390         layout isLayoutFrame ifTrue:[
  2391             layout  rightOffset:(layout rightOffset  + l).
  2392             layout bottomOffset:(layout bottomOffset + t).
  2393         ]
  2394 
  2395     ] ifFalse:[
  2396         layout isRectangle ifTrue:[
  2397             layout setLeft:(layout left + l).
  2398             layout  setTop:(layout top  + t).
  2399         ] ifFalse:[
  2400             layout isPoint ifFalse:[^ self].
  2401             layout x:(layout x + l) y:(layout y + t).
  2402         ]
  2403     ].
  2404     widget geometryLayout:layout.
  2405 !
  2406 
  2407 resizeLeft:l top:t right:r bottom:b
  2408     "resize the widget measured in pixels
  2409     "
  2410     |layout|
  2411 
  2412     self isResizeable ifFalse:[
  2413         ^ self
  2414     ].
  2415 
  2416     (layout := widget geometryLayout) isNil ifTrue:[
  2417         "Extent"
  2418         (r == l and:[b == t]) ifFalse:[
  2419             widget extent:(widget computeExtent + ((r-l) @ (b-t))).
  2420         ].
  2421         ^ self
  2422     ].
  2423 
  2424     layout isLayout ifTrue:[
  2425         layout := layout copy.
  2426 
  2427         layout leftOffset:(layout leftOffset + l)
  2428                 topOffset:(layout topOffset  + t).
  2429 
  2430         layout isLayoutFrame ifTrue:[
  2431             layout bottomOffset:(layout bottomOffset + b).
  2432             layout  rightOffset:(layout rightOffset  + r).
  2433         ]
  2434     ] ifFalse:[
  2435         layout isRectangle ifFalse:[^ self].
  2436         layout := layout copy.
  2437 
  2438         layout left:(layout left   + l)
  2439               right:(layout right  + r)
  2440                 top:(layout top    + t)
  2441              bottom:(layout bottom + b).
  2442     ].
  2443     widget geometryLayout:layout.
  2444 ! !
  2445 
  2446 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
  2447 
  2448 updateChildren
  2449     |list|
  2450 
  2451     self do:[:el|
  2452         el exists ifTrue:[
  2453             el updateChildren.
  2454         ] ifFalse:[
  2455             list isNil ifTrue:[list := OrderedCollection new].
  2456             list add:el.
  2457         ]
  2458     ].
  2459     list notNil ifTrue:[
  2460         list do:[:el| self remove:el ].
  2461     ].
  2462 !
  2463 
  2464 updateFromChildren:mergedList
  2465     "update my children against the list of items derived from
  2466      the merged list.
  2467     "
  2468 
  2469     mergedList size == 0 ifTrue:[ ^ self removeAll ].
  2470     children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
  2471 
  2472     self criticalDo:[
  2473         self nonCriticalDo:[:el| |wdg|
  2474             wdg := el widget.
  2475             mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
  2476         ].
  2477 
  2478         mergedList keysAndValuesDo:[:i :el| |wdg e2|
  2479             wdg := el widget.
  2480 
  2481             e2  := self at:i ifAbsent:nil.
  2482 
  2483             (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
  2484                 self add:el beforeIndex:i
  2485             ]
  2486         ]
  2487     ].
  2488 ! !
  2489 
  2490 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
  2491 
  2492 icon
  2493     "get the icon used for presentation
  2494     "
  2495     |specClass model|
  2496 
  2497     specClass := self specClass.
  2498     specClass isNil ifTrue:[^ nil].
  2499 
  2500     model := self treeModel.
  2501 
  2502     model notNil ifTrue:[
  2503         ^ model iconAt:specClass ifNonePut:[specClass icon]
  2504     ].
  2505     ^ specClass icon
  2506 !
  2507 
  2508 label
  2509     "get the label used for presentation
  2510     "
  2511     ^ self string
  2512 !
  2513 
  2514 printOn:aStream
  2515     "append a a printed representation of the item to aStream
  2516     "
  2517     aStream nextPutAll:(self string)
  2518 !
  2519 
  2520 string
  2521     "get the string
  2522     "
  2523     ^ widget class name.
  2524 ! !
  2525 
  2526 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
  2527 
  2528 canChangeLayout
  2529     "returns true if the layout of the widget can be changed and the
  2530      layout is not organized by its superView
  2531     "
  2532     ^ self isResizeable
  2533 !
  2534 
  2535 canResizeSubComponents
  2536     "returns true if the widget can resize its sub components
  2537     "
  2538     |specClass|
  2539 
  2540     specClass := self specClass.
  2541 
  2542     specClass notNil ifTrue:[
  2543         ^ specClass canResizeSubComponents
  2544     ].
  2545     ^ false
  2546 !
  2547 
  2548 exists
  2549     widget id notNil ifTrue:[^ true ].
  2550 
  2551     exists ~~ false ifTrue:[
  2552         exists := false.
  2553 
  2554         widget superView notNil ifTrue:[
  2555             (parent isHierarchicalItem and:[parent exists]) ifTrue:[
  2556                 exists := (parent widget subViews includesIdentical:widget).
  2557             ].
  2558         ].
  2559     ].
  2560     ^ exists
  2561 !
  2562 
  2563 isApplicationClass
  2564     |cls|
  2565 
  2566     cls := widget class.
  2567 
  2568     ^ (    cls == ApplicationSubView
  2569         or:[cls == ApplicationWindow
  2570         or:[cls == SubCanvas]]
  2571       ) 
  2572 !
  2573 
  2574 isSelected
  2575     |model|
  2576 
  2577     model := self treeModel.
  2578     model notNil ifTrue:[^ model isSelected:self].
  2579     ^ false
  2580 !
  2581 
  2582 supportsSubComponents
  2583     "returns true if the widget supports sub components
  2584     "
  2585     |specClass|
  2586 
  2587     widget isScrollWrapper ifTrue:[
  2588         ^ false
  2589     ].
  2590     specClass := self specClass.
  2591 
  2592     specClass notNil ifTrue:[
  2593         ^ specClass supportsSubComponents
  2594     ].
  2595     ^ false
  2596 ! !
  2597 
  2598 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
  2599 
  2600 isInLayoutContainer
  2601     "returns true if the widget is in a layout container
  2602     "
  2603     |sv specClass|
  2604 
  2605     sv := widget superView.
  2606 
  2607     sv notNil ifTrue:[
  2608         specClass := sv specClass.
  2609 
  2610         specClass notNil ifTrue:[
  2611             ^ specClass isLayoutContainer
  2612         ].
  2613     ].
  2614     ^ false
  2615 !
  2616 
  2617 isLayoutContainer
  2618     "answer whether corresponding view instances of the spec class can contain
  2619      (and arrange) other view
  2620     "
  2621     |specClass|
  2622 
  2623     specClass := self specClass.
  2624 
  2625     specClass notNil ifTrue:[
  2626         ^ specClass isLayoutContainer
  2627     ].
  2628     ^ false
  2629 !
  2630 
  2631 isMoveable
  2632     "returns true if the widget is not in a layout container
  2633     "
  2634     self isInLayoutContainer ifFalse:[
  2635         ^ widget superView notNil
  2636     ].
  2637     ^ false
  2638 !
  2639 
  2640 isResizeable
  2641     "returns true if the widget is resizeable
  2642     "
  2643     |sv specClass|
  2644 
  2645     sv := widget superView.
  2646 
  2647     sv notNil ifTrue:[
  2648         specClass := sv specClass.
  2649 
  2650         specClass notNil ifTrue:[
  2651             ^ specClass canResizeSubComponents
  2652         ].
  2653     ].
  2654     ^ false
  2655 ! !
  2656 
  2657 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
  2658 
  2659 documentation
  2660 "
  2661     Instances of ViewTreeModel can be used as model on a View and all
  2662     it contained subviews for a HierarchicalListView.
  2663     The model keeps two values, the hierarchical representation of the views
  2664     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
  2665     It shows the selected items highlighted.
  2666 
  2667 
  2668     [Instance variables:]
  2669         lockSema            <Semaphore>         lock selection notifications and redraws
  2670 
  2671         testModeChannel     <ValueHolder>       true, than running in test mode.
  2672 
  2673         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
  2674 
  2675         selection           <Sequence or nil>   selected items or nil
  2676 
  2677         hiddenLevel         <Integer>           internal use; redrawing the selection
  2678                                                 only is done if the counter is 0.
  2679 
  2680         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
  2681 
  2682         selectedSuperItems  <Sequence>          list of selected super items; items selected
  2683                                                 but not contained in another selected item.
  2684 
  2685         inputEventAction    <Action>            called for each InputEvent
  2686 
  2687         mappedViewAction    <Action>            called for a new mapped view which
  2688                                                 can not be found in the current item list.
  2689 
  2690         beforeSelectionChangedAction <Action>   called before the selection changed
  2691 
  2692     [author:]
  2693         Claus Atzkern
  2694 
  2695     [see also:]
  2696         ViewTreeItem
  2697 "
  2698 !
  2699 
  2700 examples
  2701 "
  2702     example 1: pick any window and show views and contained views
  2703                                                                                 [exBegin]
  2704     |top sel model panel|
  2705 
  2706     model := ViewTreeModel new.
  2707     top   := StandardSystemView new; extent:440@400.
  2708     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
  2709     sel bottomInset:24.
  2710 
  2711     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
  2712     panel topInset:-24.
  2713     panel horizontalLayout:#fitSpace.
  2714 
  2715     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
  2716     Button label:'Pick Views' action:[  |win|
  2717                                         (     (win := Screen current viewFromUser) notNil
  2718                                          and:[(win := win topView) ~~ Screen current rootView
  2719                                          and:[win ~~ top]]
  2720                                         ) ifTrue:[
  2721                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
  2722                                         ] ifFalse:[
  2723                                             model rootItem:nil
  2724                                         ]
  2725                                      ] in:panel.
  2726 
  2727     sel  multipleSelectOk:true.
  2728     sel              list:model listOfItems.
  2729     sel             model:model.
  2730     sel          useIndex:false.
  2731 
  2732     sel doubleClickAction:[:i| |el|
  2733         el := model listOfItems at:i.
  2734         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
  2735     ].
  2736     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
  2737 
  2738     model inputEventAction:[:anEvent| |item|
  2739         anEvent isButtonEvent ifTrue:[
  2740             anEvent isButtonPressEvent ifTrue:[
  2741                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
  2742             ] ifFalse:[
  2743                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  2744                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
  2745                 ]
  2746             ]
  2747         ]
  2748     ].
  2749 
  2750     top openAndWait.
  2751     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
  2752 
  2753                                                                                 [exEnd]
  2754 "
  2755 ! !
  2756 
  2757 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
  2758 
  2759 application:anApplication
  2760     listOfItems application:anApplication.
  2761 !
  2762 
  2763 rootItem
  2764     "get the rootItem the event viewer is established on
  2765     "
  2766     ^ listOfItems root
  2767 !
  2768 
  2769 rootItem:anItem
  2770     "set the rootItem the event viewer is established on
  2771     "
  2772     |expanded|
  2773 
  2774     timedUpdateTask := nil.
  2775     self deselect.
  2776 
  2777     lockSema critical:[
  2778         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
  2779                      ifFalse:[ expanded := false ].
  2780 
  2781         self value:nil.
  2782         listOfItems root:anItem.
  2783 
  2784         anItem notNil ifTrue:[
  2785             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
  2786             timedUpdateTask name:'Update'.
  2787             timedUpdateTask resume.
  2788         ].
  2789     ].
  2790 
  2791     (expanded and:[anItem notNil]) ifTrue:[
  2792         anItem expand
  2793     ].
  2794     ^ anItem
  2795 !
  2796 
  2797 rootView
  2798     "get the top widget the event viewer is established on, a View
  2799     "
  2800     ^ listOfItems rootView
  2801 ! !
  2802 
  2803 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
  2804 
  2805 beforeSelectionChangedAction
  2806     "none argument action which is called before
  2807      the selection changed
  2808     "
  2809     ^ beforeSelectionChangedAction
  2810 !
  2811 
  2812 beforeSelectionChangedAction:aNoneArgBlock
  2813     "none argument action which is called before
  2814      the selection changed
  2815     "
  2816     beforeSelectionChangedAction := aNoneArgBlock.
  2817 !
  2818 
  2819 inputEventAction
  2820     "called for each input event; the argument to the action is the WindowEvent
  2821     "
  2822     ^ inputEventAction
  2823 !
  2824 
  2825 inputEventAction:aOneArgActionTheEvent
  2826     "called for each input event; the argument to the action is the WindowEvent
  2827     "
  2828     inputEventAction := aOneArgActionTheEvent.
  2829 !
  2830 
  2831 mappedViewAction
  2832     "called for a new mapped view which can not be found
  2833      in the current item list
  2834     "
  2835     ^ mappedViewAction
  2836 !
  2837 
  2838 mappedViewAction:aOneArgBlockTheMappedView
  2839     "called for a new mapped view which can not be found
  2840      in the current item list
  2841     "
  2842     mappedViewAction := aOneArgBlockTheMappedView
  2843 ! !
  2844 
  2845 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
  2846 
  2847 iconAt:aKey ifNonePut:aNoneArgBlock
  2848     |icon view|
  2849 
  2850     icon := icons at:aKey ifAbsent:nil.
  2851     icon notNil ifTrue:[^ icon].
  2852 
  2853     icon := aNoneArgBlock value.
  2854     icon isNil ifTrue:[^ nil].
  2855 
  2856     view := self rootView.
  2857     view isNil ifTrue:[^ icon].
  2858 
  2859     icon := icon copy onDevice:(view device).
  2860     icon isImage ifTrue:[
  2861         icon clearMaskedPixels.
  2862     ].
  2863     icons at:aKey put:icon.
  2864     ^ icon
  2865 ! !
  2866 
  2867 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
  2868 
  2869 signalHiddenLevel
  2870     "show the selection if signaled; increments hiddenLevel
  2871      see: #waitHiddenLevel
  2872     "
  2873     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
  2874         hiddenLevel := 0.
  2875         self invalidateSelection.
  2876     ].
  2877 !
  2878 
  2879 waitHiddenLevel
  2880     "hide the selection until signaled; increments hiddenLevel
  2881      see: #signalHiddenLevel
  2882     "
  2883     self redrawUnselected:selection andLock:true
  2884 !
  2885 
  2886 withSelectionHiddenDo:aNoneArgumentBlock
  2887     "apply block with selection hidden
  2888     "
  2889 
  2890     [   self waitHiddenLevel.
  2891 
  2892         aNoneArgumentBlock value
  2893 
  2894     ] valueNowOrOnUnwindDo:[
  2895         self signalHiddenLevel.
  2896     ].
  2897 ! !
  2898 
  2899 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
  2900 
  2901 hasTargetWidgetChannel
  2902     "answer the channel which is set to true if a target widget exists"
  2903 
  2904     ^ hasTargetWidgetChannel
  2905 !
  2906 
  2907 listOfItems
  2908     "hiearchical list build from existing items"
  2909 
  2910     ^ listOfItems
  2911 !
  2912 
  2913 selectOnClickHolder
  2914     "boolean holder, which indicates whether the selection will change on click
  2915     "
  2916     ^ selectOnClickHolder
  2917 !
  2918 
  2919 testModeChannel
  2920     "answer a boolean channel which describes the behaviour how to process
  2921      events on the target view.
  2922 
  2923      false: all input events are eaten and the selection is shown on the target view.
  2924      true:  no  input events are eaten and no  selection is shown on the target view."
  2925 
  2926     ^ testModeChannel
  2927 ! !
  2928 
  2929 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
  2930 
  2931 targetWidgetChanged
  2932     hasTargetWidgetChannel value:(self rootItem notNil).
  2933 !
  2934 
  2935 timedUpdateTaskCycle
  2936     |view myTaskId|
  2937 
  2938     myTaskId := timedUpdateTask.
  2939 
  2940     listOfItems root notNil ifTrue:[
  2941         view := listOfItems root widget.
  2942     ].
  2943 
  2944     [ view notNil ] whileTrue:[
  2945         Delay waitForSeconds:0.5.
  2946         
  2947         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
  2948             view := nil.
  2949         ] ifTrue:[
  2950             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
  2951                 view sensor pushUserEvent:#updateChildren for:self.
  2952             ].
  2953         ].
  2954     ].
  2955     timedUpdateTask == myTaskId ifTrue:[
  2956         timedUpdateTask := nil.
  2957         listOfItems root:nil.
  2958     ].
  2959 !
  2960 
  2961 update:something with:someArgument from:aModel
  2962 
  2963     aModel == testModeChannel ifTrue:[
  2964         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
  2965             testModeChannel value ifTrue:[
  2966                 self redrawUnselected:selection andLock:false checkTestMode:false.
  2967             ] ifFalse:[
  2968                 self invalidateSelection.
  2969             ].
  2970         ].
  2971         ^ self
  2972     ].
  2973     super update:something with:someArgument from:aModel.
  2974 !
  2975 
  2976 updateChildren
  2977     |rootItem|
  2978 
  2979     rootItem := listOfItems root.
  2980     rootItem isNil ifTrue:[^ self].
  2981 
  2982     rootItem exists ifFalse:[
  2983         listOfItems root:nil.
  2984     ] ifTrue:[
  2985         rootItem updateChildren.
  2986     ].
  2987 ! !
  2988 
  2989 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
  2990 
  2991 processEvent:anEvent
  2992     "catch and process all WindowEvents for the rootComponent and its contained
  2993      widgets; redraw selection in case of damage...
  2994      return true, if the event was eaten"
  2995 
  2996     |evView item rootView testMode|
  2997 
  2998     evView := anEvent view.
  2999     evView isNil ifTrue:[
  3000         (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
  3001             ^ false
  3002         ].
  3003         anEvent value.
  3004         ^ true.
  3005     ].
  3006     rootView := listOfItems rootView.
  3007     rootView isNil ifTrue:[ ^ false ].
  3008 
  3009     anEvent isConfigureEvent ifTrue:[
  3010         hiddenLevel == 0 ifTrue:[
  3011             self redrawUnselected:selection andLock:false.
  3012         ].
  3013         ^ false
  3014     ].
  3015 
  3016     "/ check whether view is contained within the rootView
  3017     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
  3018         ^ false
  3019     ].
  3020 
  3021     anEvent isInputEvent ifFalse:[
  3022         anEvent isDamage ifTrue:[
  3023             hiddenLevel == 0 ifTrue:[self invalidateSelection].
  3024             ^ false
  3025         ].
  3026 
  3027         anEvent isMapEvent ifTrue:[
  3028             mappedViewAction notNil ifTrue:[
  3029                 item := listOfItems recursiveDetect:[:el| el widget == evView].
  3030                 item isNil ifTrue:[ mappedViewAction value:evView ]
  3031             ].
  3032             ^ false
  3033         ].
  3034 
  3035         anEvent type == #terminate ifTrue:[
  3036             item := listOfItems recursiveDetect:[:el| el widget == evView].
  3037             item notNil ifTrue:[ self processTerminateForItem:item ].
  3038             ^ false
  3039         ].
  3040         ^ false
  3041     ].
  3042     testMode := testModeChannel value.
  3043 
  3044     anEvent isFocusEvent ifTrue:[
  3045         evView == rootView ifTrue:[
  3046             self invalidateSelection
  3047         ].
  3048         ^ testMode not.
  3049     ].
  3050     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
  3051 
  3052     testMode ifFalse:[
  3053         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
  3054     ] ifTrue:[
  3055         anEvent isButtonPressEvent ifTrue:[
  3056             selectOnClickHolder value ifTrue:[
  3057                 self selectItem:(listOfItems detectItemRespondsToView:evView).
  3058             ].
  3059         ]
  3060     ].
  3061 
  3062     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
  3063         hiddenLevel := 1.
  3064         self signalHiddenLevel.
  3065     ].
  3066 
  3067     ^ testMode not
  3068 !
  3069 
  3070 processTerminateForItem:anItem
  3071     "received terminate for an item
  3072     "
  3073     anItem remove.
  3074 ! !
  3075 
  3076 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
  3077 
  3078 initialize
  3079     "setup the default attributes
  3080     "
  3081     super initialize.
  3082 
  3083     hiddenLevel           := 0.
  3084     lockSema              := RecursionLock new.
  3085     listOfItems           := ItemList new on:self.
  3086     selectedSuperItems    := #().
  3087     icons                 := IdentityDictionary new.
  3088 
  3089     hasTargetWidgetChannel := false asValue.
  3090     selectOnClickHolder    := true asValue.
  3091 
  3092     testModeChannel := false asValue.
  3093     testModeChannel addDependent:self.
  3094 ! !
  3095 
  3096 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
  3097 
  3098 invalidateSelection
  3099     "invalidate the current selection
  3100     "
  3101     |topView|
  3102 
  3103     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3104 
  3105     (     hiddenLevel == 0
  3106      and:[selection notNil
  3107      and:[(topView := listOfItems rootView) notNil
  3108      and:[topView shown]]]
  3109     ) ifTrue:[
  3110         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
  3111     ]
  3112 !
  3113 
  3114 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
  3115     "repair all views and contained views, which intersects the damage.
  3116      !!!! all damages repaired are removed from the list of damages !!!!
  3117     "
  3118     |color relOrg damage subViews repaired
  3119      bwWidth    "{ Class:SmallInteger }"
  3120      x          "{ Class:SmallInteger }"
  3121      y          "{ Class:SmallInteger }"
  3122      w          "{ Class:SmallInteger }"
  3123      h          "{ Class:SmallInteger }"
  3124      relOrgX    "{ Class:SmallInteger }"
  3125      relOrgY    "{ Class:SmallInteger }"
  3126      width      "{ Class:SmallInteger }"
  3127      height     "{ Class:SmallInteger }"
  3128      size       "{ Class:SmallInteger }"
  3129     |
  3130     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
  3131 
  3132     subViews := aView subViews.
  3133 
  3134     subViews size ~~ 0 ifTrue:[
  3135         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
  3136         theDamages isEmpty ifTrue:[ ^ self ].
  3137     ].
  3138 
  3139     relOrg  := aView originRelativeTo:aRootView.
  3140     bwWidth := aView borderWidth.
  3141     size    := theDamages size.
  3142 
  3143     "/ compute relative origin starting from border left@top
  3144     relOrgX := relOrg x - bwWidth.
  3145     relOrgY := relOrg y - bwWidth.
  3146     width   := aView width  + bwWidth + bwWidth.
  3147     height  := aView height + bwWidth + bwWidth.
  3148 
  3149     size to:1 by:-1 do:[:anIndex|
  3150         repaired := damage := theDamages at:anIndex.
  3151 
  3152         "/ compute the rectangle into the view
  3153         y := damage top  - relOrgY.
  3154         x := damage left - relOrgX.
  3155         w := damage width.
  3156         h := damage height.
  3157 
  3158         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
  3159         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
  3160         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
  3161         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
  3162 
  3163         (w > 0 and:[h > 0]) ifTrue:[
  3164             bwWidth ~~ 0 ifTrue:[
  3165                 color isNil ifTrue:[
  3166                     "/ must force redraw of border
  3167                     color := aView borderColor.
  3168                     aView borderColor:(Color colorId:1).
  3169                     aView borderColor:color.
  3170                 ].
  3171                 w := w - bwWidth.
  3172                 h := h - bwWidth.
  3173 
  3174                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
  3175                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
  3176 
  3177                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
  3178             ].
  3179 
  3180             w > 0 ifTrue:[
  3181                 aView clearRectangleX:x y:y width:w height:h.
  3182                 aView exposeX:x y:y width:w height:h
  3183             ].
  3184             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
  3185         ]
  3186     ].
  3187 !
  3188 
  3189 redrawSelection
  3190     "redraw all items selected
  3191     "
  3192     |topView size|
  3193 
  3194     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3195 
  3196     (     hiddenLevel == 0
  3197      and:[(size := selection size) > 0
  3198      and:[(topView := listOfItems rootView) notNil
  3199      and:[topView shown
  3200      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
  3201     ) ifFalse:[
  3202         ^ self
  3203     ].
  3204 
  3205     lockSema critical:[
  3206         |list|
  3207 
  3208         list := selection.
  3209 
  3210         list size > 0 ifTrue:[
  3211             topView paint:(Color black).
  3212             topView clippedByChildren:false.
  3213 
  3214             list keysAndValuesReverseDo:[:anIndex :anItem|
  3215                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
  3216 
  3217                 anItem handlesDo:[:aRect :what|
  3218                     what isNil ifTrue:[topView displayRectangle:aRect]
  3219                               ifFalse:[topView    fillRectangle:aRect]
  3220                 ]
  3221             ].
  3222             topView clippedByChildren:true.
  3223         ].
  3224     ].
  3225 !
  3226 
  3227 redrawUnselected:aList andLock:doLock
  3228     "redraw all items unselected; if doLock is true, the hiddenLevel
  3229      is incremented and thus the select mechanism is locked.
  3230     "
  3231     self redrawUnselected:aList andLock:doLock checkTestMode:true.
  3232 !
  3233 
  3234 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
  3235     "redraw all items unselected; if doLock is true, the hiddenLevel
  3236      is incremented and thus the select mechanism is locked.
  3237     "
  3238     |rootView damages subViews x y w h|
  3239 
  3240     doLock ifTrue:[
  3241         hiddenLevel := hiddenLevel + 1.
  3242         hiddenLevel ~~ 1 ifTrue:[^ self].
  3243     ] ifFalse:[
  3244         hiddenLevel ~~ 0 ifTrue:[^ self].
  3245     ].
  3246     checkTestMode ifTrue:[
  3247         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3248     ].
  3249 
  3250     (     aList size ~~ 0
  3251      and:[(rootView := listOfItems rootView) notNil
  3252      and:[rootView shown]]
  3253     ) ifFalse:[
  3254         ^ self
  3255     ].
  3256 
  3257     lockSema critical:[
  3258         damages := OrderedCollection new:(8 * aList size).
  3259 
  3260         aList do:[:item|
  3261             item handlesDo:[:handle :what|
  3262                 damages reverseDo:[:el|
  3263                     (el intersects:handle) ifTrue:[
  3264                         damages removeIdentical:el.
  3265 
  3266                         handle left:(handle left   min:el left)
  3267                               right:(handle right  max:el right)
  3268                                 top:(handle top    min:el top)
  3269                              bottom:(handle bottom max:el bottom)
  3270                     ]
  3271                 ].                        
  3272                 damages add:handle
  3273             ]
  3274         ].
  3275 
  3276         damages do:[:el|
  3277             x := el left.
  3278             y := el top.
  3279             w := el width.
  3280             h := el height.
  3281 
  3282             rootView clearRectangleX:x y:y width:w height:h.
  3283             rootView         exposeX:x y:y width:w height:h.
  3284         ].
  3285 
  3286         (subViews := rootView subViews) notNil ifTrue:[
  3287             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
  3288         ].
  3289     ].
  3290 ! !
  3291 
  3292 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
  3293 
  3294 isInTestMode
  3295     "answer false, all input events are eaten and the selection is shown on the target view.
  3296      answer true,  no  input events are eaten and no  selection is shown on the target view."
  3297 
  3298     ^ testModeChannel value
  3299 ! !
  3300 
  3301 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
  3302 
  3303 at:anIndex
  3304     "returns the selected item at an index or nil
  3305     "
  3306     selection notNil ifTrue:[
  3307         ^ selection at:anIndex ifAbsent:nil
  3308     ].
  3309     ^ nil
  3310 !
  3311 
  3312 at:anIndex ifAbsent:aBlock
  3313     "returns the selected item at an index or the result of the block
  3314     "
  3315     selection notNil ifTrue:[
  3316         ^ selection at:anIndex ifAbsent:aBlock
  3317     ].
  3318     ^ aBlock value
  3319 !
  3320 
  3321 first
  3322     "returns the first selected item or nil
  3323     "
  3324     ^ self at:1
  3325 !
  3326 
  3327 last
  3328     "returns the last selected item or nil
  3329     "
  3330     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
  3331 !
  3332 
  3333 selectedItem
  3334     "returns the single selected item or nil (size ~~ 1 nil is returned)
  3335     "
  3336     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
  3337 !
  3338 
  3339 selectedSuperItems
  3340     "returs the list of selected superItems; items selected
  3341      but not contained in another selected item.
  3342     "
  3343     ^ selectedSuperItems
  3344 !
  3345 
  3346 size
  3347     "returns the number of items selected
  3348     "
  3349     ^ selection size
  3350 ! !
  3351 
  3352 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
  3353 
  3354 add:item
  3355     "add an item to the current selection
  3356     "
  3357     |newSelect|
  3358 
  3359     item isNil ifTrue:[^ item].
  3360 
  3361     lockSema critical:[
  3362         selection isNil ifTrue:[
  3363             newSelect := Array with:item.
  3364         ] ifFalse:[
  3365             (self includes:item) ifFalse:[
  3366                 newSelect := selection copyWith:item
  3367             ]
  3368         ].
  3369 
  3370         newSelect size ~~ selection size ifTrue:[
  3371             item makeVisible.
  3372             self value:newSelect
  3373         ]
  3374     ].
  3375     ^ item
  3376 !
  3377 
  3378 addAll:aCollectionOfItems
  3379     "add a collection of items to the current selection
  3380     "
  3381     |newSelect|
  3382 
  3383     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
  3384 
  3385     lockSema critical:[
  3386         selection isNil ifTrue:[
  3387             newSelect := Array withAll:aCollectionOfItems.
  3388         ] ifFalse:[
  3389             newSelect := OrderedCollection withAll:selection.
  3390 
  3391             aCollectionOfItems do:[:el|
  3392                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
  3393             ].
  3394         ].
  3395         self value:newSelect.
  3396     ].
  3397     ^ aCollectionOfItems
  3398 !
  3399 
  3400 deselect
  3401     "clear the selection
  3402     "
  3403     self value:nil.
  3404 !
  3405 
  3406 remove:item
  3407     "remove the item from the current selection
  3408     "
  3409     |newSelect|
  3410 
  3411     item isNil ifTrue:[^ nil].
  3412 
  3413     lockSema critical:[
  3414         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
  3415             selection size == 1 ifTrue:[ newSelect := nil ]
  3416                                ifFalse:[ newSelect := selection copyWithout:item ].
  3417 
  3418             self value:newSelect
  3419         ].
  3420     ].
  3421     ^ item
  3422 !
  3423 
  3424 removeAll
  3425     "clear the selection
  3426     "
  3427     self deselect.
  3428 !
  3429 
  3430 removeAll:loItems
  3431     "remove all items of the collection from the current selection
  3432     "
  3433     |newSelect|
  3434 
  3435     selection   isNil ifTrue:[ ^ loItems ].
  3436     loItems size == 0 ifTrue:[ ^ loItems ].
  3437 
  3438     lockSema critical:[
  3439         selection notNil ifTrue:[
  3440             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
  3441             self value:newSelect.
  3442         ]
  3443     ].
  3444     ^ loItems
  3445 !
  3446 
  3447 selectAll
  3448     "select all items
  3449     "
  3450     |root newSelection|
  3451 
  3452     root := listOfItems root.
  3453 
  3454     root isNil ifTrue:[
  3455         newSelection := nil
  3456     ] ifFalse:[
  3457         newSelection := OrderedCollection new.
  3458         root recursiveDo:[:el| newSelection add:el ].
  3459     ].
  3460     self value:newSelection.
  3461 !
  3462 
  3463 selectItem:anItem
  3464     "set the current selection to the item
  3465     "
  3466     self value:anItem
  3467 !
  3468 
  3469 selectRootItem
  3470     "set the current selection to the root item
  3471     "
  3472     self value:(self rootItem).
  3473 !
  3474 
  3475 selectedItem:anItem
  3476     "set the current selection to the item
  3477     "
  3478     self selectItem:anItem.
  3479 !
  3480 
  3481 toggleSelectItem:anItem
  3482     "toggle selection-state of the item; add or remove the item from the
  3483      current selection.
  3484     "
  3485     anItem notNil ifTrue:[
  3486         (self includes:anItem) ifTrue:[self remove:anItem]
  3487                               ifFalse:[self add:anItem]
  3488     ].
  3489     ^ anItem
  3490 ! !
  3491 
  3492 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
  3493 
  3494 collect:aBlock
  3495     "for each element in the selection, evaluate the argument, aBlock
  3496      and return a new collection with the results
  3497     "
  3498     |res|
  3499 
  3500     res := OrderedCollection new.
  3501     self do:[:el| res add:(aBlock value:el)].
  3502   ^ res
  3503 !
  3504 
  3505 do:aOneArgBlock
  3506     "evaluate the argument, aBlock for each item in the selection
  3507     "
  3508     |cashedSelection|
  3509 
  3510     cashedSelection := selection.
  3511     cashedSelection isNil ifTrue:[^ nil].
  3512   ^ cashedSelection do:aOneArgBlock
  3513 !
  3514 
  3515 from:start do:aOneArgBlock
  3516     "evaluate the argument, aBlock for the items starting at index start
  3517     "
  3518     |cashedSelection|
  3519 
  3520     cashedSelection := selection.
  3521     cashedSelection isNil ifTrue:[^ nil].
  3522   ^ cashedSelection from:start do:aOneArgBlock
  3523 !
  3524 
  3525 from:start to:stop do:aOneArgBlock
  3526     "evaluate the argument, aBlock for the items with index start to
  3527      stop in the selection.
  3528     "
  3529     |cashedSelection|
  3530 
  3531     cashedSelection := selection.
  3532     cashedSelection isNil ifTrue:[^ nil].
  3533   ^ cashedSelection from:start to:stop do:aOneArgBlock
  3534 !
  3535 
  3536 reverseDo:aOneArgBlock
  3537     "evaluate the argument, aBlock for each item in the selection
  3538     "
  3539     |cashedSelection|
  3540 
  3541     cashedSelection := selection.
  3542     cashedSelection isNil ifTrue:[^ nil].
  3543   ^ cashedSelection reverseDo:aOneArgBlock
  3544 !
  3545 
  3546 select:aBlock
  3547     "return a new collection with all elements from the selection, for which
  3548      the argument aBlock evaluates to true.
  3549     "
  3550     |res|
  3551 
  3552     res := OrderedCollection new.
  3553     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
  3554   ^ res
  3555 ! !
  3556 
  3557 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
  3558 
  3559 changed:aParameter with:oldSelection
  3560     "update the visibility staus of the current selection
  3561     "
  3562     |unselected rootView rootItem selSize|
  3563 
  3564     selSize := selection size.
  3565 
  3566     selSize == 0 ifTrue:[
  3567         selectedSuperItems := #().
  3568     ] ifFalse:[
  3569         selSize == 1 ifTrue:[
  3570             selectedSuperItems := Array with:(selection at:1).
  3571         ] ifFalse:[
  3572             rootItem := listOfItems root.
  3573 
  3574             (selection includesIdentical:rootItem) ifTrue:[
  3575                 selectedSuperItems := Array with:rootItem.
  3576             ] ifFalse:[
  3577                 selectedSuperItems := OrderedCollection new:selSize.
  3578 
  3579                 selection do:[:anItem|
  3580                     anItem parentsDetect:[:el| selection includesIdentical:el ]
  3581                                   ifNone:[ selectedSuperItems add:anItem ].
  3582                 ].
  3583             ]
  3584         ]
  3585     ].
  3586 
  3587     (     hiddenLevel == 0
  3588      and:[(rootView := listOfItems rootView) notNil
  3589      and:[rootView shown]]
  3590     ) ifTrue:[
  3591         selSize == 0 ifTrue:[
  3592             "/ must redraw the old selection unselected
  3593             self redrawUnselected:oldSelection andLock:false
  3594         ] ifFalse:[
  3595             self invalidateSelection.
  3596 
  3597             oldSelection size ~~ 0 ifTrue:[
  3598                 "/ must redraw all elements no longer in the selection
  3599                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
  3600                 self redrawUnselected:unselected andLock:false.
  3601             ]
  3602         ]
  3603     ].
  3604     super changed:aParameter with:oldSelection.
  3605 !
  3606 
  3607 setValue:aNewSelection 
  3608     "set the selection without notifying
  3609     "
  3610     |newSelect idx|
  3611 
  3612     newSelect := nil.
  3613 
  3614     aNewSelection notNil ifTrue:[
  3615         lockSema critical:[
  3616             aNewSelection isCollection ifFalse:[
  3617                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
  3618                     newSelect := selection
  3619                 ] ifFalse:[
  3620                     newSelect := Array with:aNewSelection.
  3621                 ]
  3622             ] ifTrue:[
  3623                 aNewSelection notEmpty ifTrue:[
  3624                     aNewSelection size ~~ selection size ifTrue:[
  3625                         newSelect := aNewSelection copy.
  3626                     ] ifFalse:[
  3627                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
  3628 
  3629                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
  3630                                 ifFalse:[newSelect := selection ].
  3631                     ]
  3632                 ]
  3633             ]
  3634         ].
  3635     ].
  3636     newSelect ~~ selection ifTrue:[
  3637         beforeSelectionChangedAction value.
  3638         selection := newSelect.
  3639         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  3640     ].
  3641 !
  3642 
  3643 triggerValue:aValue
  3644     "set my value & send change notifications to my dependents.
  3645      Send the change message even if the value didn't change.
  3646     "
  3647     |oldSelection|
  3648 
  3649     lockSema critical:[
  3650         oldSelection := selection.
  3651         self setValue:aValue.
  3652         self changed:#value with:oldSelection
  3653     ]
  3654 !
  3655 
  3656 value
  3657     "returns the current selection
  3658     "
  3659     ^ selection ? #()
  3660 !
  3661 
  3662 value:aValue
  3663     "change the current selection and send change notifications to my
  3664      dependents if it changed.
  3665     "
  3666     |oldSelection|
  3667 
  3668     lockSema critical:[
  3669         oldSelection := selection.
  3670         self setValue:aValue.
  3671 
  3672         oldSelection == selection ifFalse:[
  3673             self changed:#value with:oldSelection
  3674         ]
  3675     ].
  3676 ! !
  3677 
  3678 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
  3679 
  3680 detect:aBlock
  3681     "evaluate the argument, aBlock for each item in the selection until
  3682      the block returns true; in this case return the element which caused
  3683      the true evaluation.
  3684      If none of the evaluations returns true, an error is raised
  3685     "
  3686     ^ self detect:aBlock ifNone:[self errorNotFound]
  3687 !
  3688 
  3689 detect:aBlock ifNone:exceptionBlock
  3690     "evaluate the argument, aBlock for each item in the selection until the
  3691      block returns true; in this case return the element which caused the
  3692      true evaluation.
  3693      If none of the evaluations returns true, the result of the evaluation
  3694      of the exceptionBlock is returned
  3695     "
  3696     |cashedSelection|
  3697 
  3698     cashedSelection := selection.
  3699     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3700   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  3701 !
  3702 
  3703 detectLast:aBlock
  3704     "evaluate the argument, aBlock for each item in the selection until
  3705      the block returns true; in this case return the element which caused
  3706      the true evaluation. The items are processed in reverse order.
  3707      If none of the evaluations returns true, an error is raised
  3708     "
  3709     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  3710 !
  3711 
  3712 detectLast:aBlock ifNone:exceptionBlock
  3713     "evaluate the argument, aBlock for each item in the selection until
  3714      the block returns true; in this case return the element which caused
  3715      the true evaluation. The items are processed in reverse order.
  3716      If none of the evaluations returns true, the result of the evaluation
  3717      of the exceptionBlock is returned
  3718     "
  3719     |cashedSelection|
  3720 
  3721     cashedSelection := selection.
  3722     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3723   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  3724 ! !
  3725 
  3726 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
  3727 
  3728 includes:anItem
  3729     "returns true if the item is in the current selection
  3730     "
  3731     |cashedSelection|
  3732 
  3733     cashedSelection := selection.
  3734     cashedSelection isNil ifTrue:[^ false].
  3735  ^  cashedSelection includesIdentical:anItem
  3736 !
  3737 
  3738 includesAll:aCollection
  3739     "return true, if all items of the collection are included in the current selection
  3740     "
  3741     |cashedSelection|
  3742 
  3743     aCollection size ~~ 0 ifTrue:[
  3744         cashedSelection := selection.
  3745         cashedSelection isNil ifTrue:[ ^ false ].
  3746 
  3747         aCollection do:[:el|
  3748             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  3749         ]
  3750     ].
  3751     ^ true
  3752 !
  3753 
  3754 includesAny:aCollection
  3755     "return true, if the any item of the collection is in the current selection
  3756     "
  3757     |cashedSelection|
  3758 
  3759     aCollection notNil ifTrue:[
  3760         cashedSelection := selection.
  3761 
  3762         cashedSelection notNil ifTrue:[
  3763             aCollection do:[:el|
  3764                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  3765             ]
  3766         ]
  3767     ].
  3768     ^ false
  3769 !
  3770 
  3771 includesIdentical:anItem
  3772     "returns true if the item is in the current selection
  3773     "
  3774     ^ self includes:anItem
  3775 !
  3776 
  3777 isEmpty
  3778     "returns true if the current selection is empty
  3779     "
  3780     ^ selection size == 0
  3781 !
  3782 
  3783 isSelected:anItem
  3784     "returns true if the item is in the current selection
  3785     "
  3786     ^ self includes:anItem
  3787 !
  3788 
  3789 notEmpty
  3790     "returns true if the current selection is not empty
  3791     "
  3792     ^ selection size ~~ 0
  3793 ! !
  3794 
  3795 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
  3796 
  3797 documentation
  3798 "
  3799     Kind of HierarchicalList class which contains all the visible
  3800     ViewTreeItem's and the root, the anchor of the hierarchical list.
  3801 
  3802     [Instance variables:]
  3803         treeModel       <ViewTreeModel>         all events are delegated to
  3804         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  3805 
  3806 
  3807     [author:]
  3808         Claus Atzkern
  3809 
  3810     [see also:]
  3811         HierarchicalList
  3812         ViewTreeModel
  3813         ViewTreeItem
  3814 "
  3815 ! !
  3816 
  3817 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
  3818 
  3819 root:theRoot
  3820     "set the root item; delegate events to my treeModel
  3821     "
  3822     |rootView|
  3823 
  3824     theRoot == root ifTrue:[^ self].
  3825 
  3826     rootView := self rootView.
  3827     super root:theRoot.
  3828 
  3829     rootView notNil ifTrue:[ |wgrp|
  3830         wgrp := rootView windowGroup.
  3831 
  3832         wgrp notNil ifTrue:[
  3833            wgrp removePreEventHook:treeModel.
  3834            wgrp removePostEventHook:self.
  3835         ].
  3836     ].
  3837 
  3838     super root:theRoot.
  3839     rootView := self rootView.
  3840 
  3841     rootView notNil ifTrue:[
  3842         "must setup a task because there might not exist a windowGroup at the moment
  3843         "
  3844         [   |wgrp|
  3845 
  3846             [rootView == self rootView] whileTrue:[
  3847                 wgrp := rootView windowGroup.
  3848                 wgrp notNil ifTrue:[
  3849                     rootView := nil.
  3850                     wgrp addPreEventHook:treeModel.
  3851                     wgrp addPostEventHook:self.
  3852                 ] ifFalse:[
  3853                     Delay waitForMilliseconds:100.
  3854                 ].
  3855             ].
  3856 
  3857         ] forkAt:(Processor userSchedulingPriority + 2).
  3858     ].
  3859     treeModel notNil ifTrue:[
  3860         treeModel targetWidgetChanged.
  3861     ].
  3862     
  3863     ^ root.
  3864 !
  3865 
  3866 rootView
  3867     "returns the widget assigned to the root or nil
  3868     "
  3869     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  3870 !
  3871 
  3872 treeModel
  3873     "returne the treeModel, a ViewTreeModel
  3874     "
  3875     ^ treeModel
  3876 ! !
  3877 
  3878 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
  3879 
  3880 additionalLabelForItem:anItem
  3881     "answer the additional lable for an item or nil"
  3882 
  3883     |applClass|
  3884 
  3885     showWidgetNames == true ifTrue:[
  3886         ^ '[', anItem widget name, ']'
  3887     ].
  3888 
  3889     anItem isApplicationClass ifTrue:[
  3890         applClass := anItem applicationClass.
  3891 
  3892         applClass notNil ifTrue:[
  3893             ^ ('[', applClass name, ']')
  3894         ].
  3895     ].
  3896     ^ nil
  3897 !
  3898 
  3899 showWidgetNames
  3900     "answer true if the additional text is the widget name
  3901      otherwise the name of the application"
  3902 
  3903     ^ showWidgetNames ? false
  3904 !
  3905 
  3906 showWidgetNames:aBoolean
  3907     "set true if the additional text is the widget name
  3908      otherwise the name of the application"
  3909 
  3910     self showWidgetNames == aBoolean ifFalse:[
  3911         showWidgetNames := aBoolean.
  3912 
  3913         root notNil ifTrue:[
  3914             root recursiveAdditionalNameBehaviourChanged.
  3915             self changed.
  3916         ].
  3917     ].
  3918 ! !
  3919 
  3920 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
  3921 
  3922 processEvent:anEvent
  3923     "post process event
  3924     "
  3925     ^ treeModel isInTestMode not
  3926 ! !
  3927 
  3928 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
  3929 
  3930 on:aModel
  3931     "set the model, a ViewTreeModel
  3932     "
  3933     treeModel := aModel.
  3934     showRoot  := true.
  3935     showWidgetNames := false.
  3936 ! !
  3937 
  3938 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
  3939 
  3940 detectItemRespondsToView:aView
  3941     "returns the bottom-most item which contains the view
  3942     "
  3943     |view item topView|
  3944 
  3945     root notNil ifTrue:[
  3946         view    := aView.
  3947         topView := root widget.
  3948 
  3949         [ view notNil ] whileTrue:[
  3950             topView == view ifTrue:[^ root].
  3951             item := root recursiveDetect:[:el| el widget == view ].
  3952             item notNil ifTrue:[^ item].
  3953             view := view superView
  3954         ]
  3955     ].
  3956     ^ nil
  3957 !
  3958 
  3959 recursiveDetect:aOneOrgBlock
  3960     "recursive find the first child, for which evaluation 
  3961      of the block returns true; if none nil is returned
  3962     "
  3963     root notNil ifTrue:[
  3964         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  3965       ^ root recursiveDetect:aOneOrgBlock
  3966     ].
  3967     ^ nil
  3968 ! !
  3969 
  3970 !ViewTreeInspectorApplication class methodsFor:'documentation'!
  3971 
  3972 version
  3973     ^ '$Header$'
  3974 !
  3975 
  3976 version_CVS
  3977     ^ '$Header$'
  3978 ! !
  3979 
  3980 ViewTreeInspectorApplication initialize!
  3981 ViewTreeInspectorApplication::ViewTreeItem initialize!