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