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