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