Tools__ViewTreeApplication.st
author ca
Sat, 07 Feb 2009 17:11:33 +0100
changeset 2458 64d8f3c973b3
parent 2455 93aaf62a6b95
child 2744 5bee95e91ffd
permissions -rw-r--r--
*** empty log message ***
     1 "{ Package: 'stx:libtool2' }"
     2 
     3 "{ NameSpace: Tools }"
     4 
     5 ApplicationModel subclass:#ViewTreeApplication
     6 	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
     7 		motionAction process followFocusChannel showNamesHolder'
     8 	classVariableNames:''
     9 	poolDictionaries:''
    10 	category:'A-Views-Support'
    11 !
    12 
    13 Object subclass:#MenuDesc
    14 	instanceVariableNames:'title value action'
    15 	classVariableNames:''
    16 	poolDictionaries:''
    17 	privateIn:ViewTreeApplication
    18 !
    19 
    20 !ViewTreeApplication class methodsFor:'documentation'!
    21 
    22 documentation
    23 "
    24      Small application showing a ViewTreeModel use.
    25 
    26      It displays a hierarchical list of a selected TopView and
    27      all its contained subViews.
    28      Useful to have a look at subcomponents - to see how views
    29      are structured.
    30 
    31 
    32     [Instance variables:]
    33         model           <ViewTreeModel>      the used ViewTreeModel
    34         clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
    35         clickedPoint    <Point>              point where the motion action started from.
    36         motionAction    <Action>             (oneArg-) action called durring buttonMotion.
    37 
    38 
    39     [author:]
    40         Claus Atzkern
    41 
    42     [see also:]
    43         ViewTreeModel
    44         ViewTreeItem
    45 "
    46 ! !
    47 
    48 !ViewTreeApplication class methodsFor:'initialization'!
    49 
    50 initialize
    51     "add myself to the launcher menu
    52     "
    53     self installInLauncher.
    54 !
    55 
    56 installInLauncher
    57     "add myself to the launcher menu
    58     "
    59     |menuItem icon|
    60 
    61     NewLauncher isNil ifTrue:[^ self].
    62 
    63     icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
    64 
    65     menuItem := MenuItem new 
    66                     label: 'View Inspector';
    67                     value: [ ViewTreeApplication open];
    68                     isButton: true;
    69                     icon: icon;
    70                     nameKey: #viewInspect.
    71 
    72     menuItem startGroup:#right.
    73     NewLauncher addMenuItem:menuItem in:'toolbar'
    74                    position:#( #before #help)
    75                       space:false.
    76 
    77 "
    78 self installInLauncher
    79 self removeFromLauncher
    80 "
    81 !
    82 
    83 postAutoload
    84     "add myself to the launcher menu
    85     "
    86     self installInLauncher.
    87 "
    88 self installInLauncher
    89 self removeFromLauncher
    90 "
    91 !
    92 
    93 removeFromLauncher
    94     "remove myself from the launcher menu
    95     "
    96     NewLauncher isNil ifTrue:[^ self].
    97     NewLauncher removeUserTool:#viewInspect
    98 
    99 "
   100 self installInLauncher
   101 self removeFromLauncher
   102 "
   103 !
   104 
   105 unload
   106     "class is about to be unloaded - remove myself from the launcher menu
   107     "
   108     self removeFromLauncher.
   109     super unload.
   110 ! !
   111 
   112 !ViewTreeApplication class methodsFor:'interface specs'!
   113 
   114 windowSpec
   115     "This resource specification was automatically generated
   116      by the UIPainter of ST/X."
   117 
   118     "Do not manually edit this!! If it is corrupted,
   119      the UIPainter may not be able to read the specification."
   120 
   121     "
   122      UIPainter new openOnClass:Tools::ViewTreeApplication andSelector:#windowSpec
   123      Tools::ViewTreeApplication new openInterface:#windowSpec
   124      Tools::ViewTreeApplication open
   125     "
   126 
   127     <resource: #canvas>
   128 
   129     ^ 
   130      #(FullSpec
   131         name: windowSpec
   132         window: 
   133        (WindowSpec
   134           label: 'ViewTreeInspector'
   135           name: 'ViewTreeInspector'
   136           min: (Point 10 10)
   137           max: (Point 1024 9999)
   138           bounds: (Rectangle 0 0 381 654)
   139           menu: menu
   140         )
   141         component: 
   142        (SpecCollection
   143           collection: (
   144            (MenuPanelSpec
   145               name: 'toolbarMenu'
   146               layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)
   147               menu: toolbarMenu
   148               textDefault: true
   149             )
   150            (HierarchicalListViewSpec
   151               name: 'List'
   152               layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 0 1.0)
   153               level: 1
   154               model: model
   155               menu: middleButtonMenu
   156               hasHorizontalScrollBar: true
   157               hasVerticalScrollBar: true
   158               miniScrollerHorizontal: true
   159               miniScrollerVertical: false
   160               listModel: listOfItems
   161               multipleSelectOk: true
   162               useIndex: false
   163               highlightMode: label
   164               showLeftIndicators: false
   165               indicatorSelector: indicatorClicked:
   166               useDefaultIcons: false
   167               postBuildCallback: postBuildTree:
   168             )
   169            )
   170          
   171         )
   172       )
   173 ! !
   174 
   175 !ViewTreeApplication class methodsFor:'menu specs'!
   176 
   177 menu
   178     "This resource specification was automatically generated
   179      by the MenuEditor of ST/X."
   180 
   181     "Do not manually edit this!! If it is corrupted,
   182      the MenuEditor may not be able to read the specification."
   183 
   184     "
   185      MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
   186      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
   187     "
   188 
   189     <resource: #menu>
   190 
   191     ^ 
   192      #(Menu
   193         (
   194          (MenuItem
   195             label: 'File'
   196             translateLabel: true
   197             submenu: 
   198            (Menu
   199               (
   200                (MenuItem
   201                   label: 'Pick a View'
   202                   itemValue: doPickViews
   203                   translateLabel: true
   204                 )
   205                (MenuItem
   206                   enabled: hasTargetWidgetChannel
   207                   label: 'Release Picked View'
   208                   itemValue: doUnpick
   209                   translateLabel: true
   210                 )
   211                (MenuItem
   212                   label: '-'
   213                 )
   214                (MenuItem
   215                   label: 'Exit'
   216                   itemValue: closeRequest
   217                   translateLabel: true
   218                 )
   219                )
   220               nil
   221               nil
   222             )
   223           )
   224          (MenuItem
   225             label: 'Settings'
   226             translateLabel: true
   227             submenu: 
   228            (Menu
   229               (
   230                (MenuItem
   231                   label: 'Test Mode'
   232                   translateLabel: true
   233                   hideMenuOnActivated: false
   234                   indication: testModeChannel
   235                 )
   236                (MenuItem
   237                   enabled: testModeChannel
   238                   label: 'Follow Focus'
   239                   translateLabel: true
   240                   hideMenuOnActivated: false
   241                   indication: followFocusChannel
   242                 )
   243                (MenuItem
   244                   label: '-'
   245                 )
   246                (MenuItem
   247                   label: 'Select on Click'
   248                   translateLabel: true
   249                   hideMenuOnActivated: false
   250                   indication: selectOnClickHolder
   251                 )
   252                (MenuItem
   253                   label: '-'
   254                 )
   255                (MenuItem
   256                   label: 'Show Name of Widgets'
   257                   translateLabel: true
   258                   hideMenuOnActivated: false
   259                   indication: showNamesHolder
   260                 )
   261                )
   262               nil
   263               nil
   264             )
   265           )
   266          (MenuItem
   267             label: ''
   268           )
   269          (MenuItem
   270             enabled: hasSingleSelectionHolder
   271             label: 'Menu'
   272             translateLabel: true
   273             submenuChannel: middleButtonMenu
   274           )
   275          (MenuItem
   276             enabled: hasTargetWidgetChannel
   277             label: 'Components'
   278             translateLabel: true
   279             startGroup: right
   280             submenuChannel: submenuComponents:
   281           )
   282          (MenuItem
   283             enabled: hasTargetWidgetChannel
   284             label: 'Applications'
   285             translateLabel: true
   286             submenuChannel: submenuApplications:
   287           )
   288          )
   289         nil
   290         nil
   291       )
   292 !
   293 
   294 middleButtonMenu
   295     "This resource specification was automatically generated
   296      by the MenuEditor of ST/X."
   297 
   298     "Do not manually edit this!! If it is corrupted,
   299      the MenuEditor may not be able to read the specification."
   300 
   301     "
   302      MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
   303      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
   304     "
   305 
   306     <resource: #menu>
   307 
   308     ^ 
   309      #(Menu
   310         (
   311          (MenuItem
   312             label: 'Geometry'
   313             translateLabel: true
   314             submenuChannel: submenuGeometry:
   315             keepLinkedMenu: true
   316           )
   317          (MenuItem
   318             label: 'Interface'
   319             translateLabel: true
   320             submenuChannel: submenuInterface:
   321             keepLinkedMenu: true
   322           )
   323          (MenuItem
   324             label: 'Visibility'
   325             translateLabel: true
   326             submenuChannel: submenuVisibility:
   327             keepLinkedMenu: true
   328           )
   329          (MenuItem
   330             label: '-'
   331           )
   332          (MenuItem
   333             label: 'Browse View Class'
   334             itemValue: doBrowse:
   335             translateLabel: true
   336             argument: view
   337           )
   338          (MenuItem
   339             label: 'Browse Model Class'
   340             itemValue: doBrowse:
   341             translateLabel: true
   342             isVisible: hasModel
   343             argument: model
   344           )
   345          (MenuItem
   346             label: 'Browse Application Class'
   347             itemValue: doBrowse:
   348             translateLabel: true
   349             isVisible: hasApplication
   350             argument: application
   351           )
   352          (MenuItem
   353             label: 'Browse Controller Class'
   354             itemValue: doBrowse:
   355             translateLabel: true
   356             isVisible: hasController
   357             argument: controller
   358           )
   359          (MenuItem
   360             label: '-'
   361           )
   362          (MenuItem
   363             label: 'Inspect View'
   364             itemValue: doInspect:
   365             translateLabel: true
   366             argument: view
   367           )
   368          (MenuItem
   369             label: 'Inspect Window Group'
   370             itemValue: doInspect:
   371             translateLabel: true
   372             argument: group
   373           )
   374          (MenuItem
   375             label: 'Inspect Model'
   376             itemValue: doInspect:
   377             translateLabel: true
   378             isVisible: hasModel
   379             argument: model
   380           )
   381          (MenuItem
   382             label: 'Inspect Application'
   383             itemValue: doInspect:
   384             translateLabel: true
   385             isVisible: hasApplication
   386             argument: application
   387           )
   388          (MenuItem
   389             label: 'Inspect Controller'
   390             itemValue: doInspect:
   391             translateLabel: true
   392             isVisible: hasController
   393             argument: controller
   394           )
   395          (MenuItem
   396             label: '-'
   397           )
   398          (MenuItem
   399             label: 'Flash'
   400             itemValue: doFlash
   401             translateLabel: true
   402           )
   403          (MenuItem
   404             label: '-'
   405           )
   406          (MenuItem
   407             label: 'Destroy'
   408             itemValue: doDestroy
   409             translateLabel: true
   410           )
   411          (MenuItem
   412             label: '-'
   413           )
   414          (MenuItem
   415             label: 'Instance Variables'
   416             translateLabel: true
   417             submenuChannel: submenuInspector:
   418             keepLinkedMenu: true
   419           )
   420          (MenuItem
   421             label: '='
   422           )
   423          (MenuItem
   424             label: ''
   425           )
   426          (MenuItem
   427             enabled: selectedComponentHasChildren
   428             label: 'Applications'
   429             nameKey: single
   430             translateLabel: true
   431             submenuChannel: submenuApplications:
   432             keepLinkedMenu: true
   433           )
   434          (MenuItem
   435             enabled: selectedComponentHasChildren
   436             label: 'Components'
   437             nameKey: single
   438             translateLabel: true
   439             submenuChannel: submenuComponents:
   440             keepLinkedMenu: true
   441           )
   442          )
   443         nil
   444         nil
   445       )
   446 !
   447 
   448 toolbarMenu
   449     "This resource specification was automatically generated
   450      by the MenuEditor of ST/X."
   451 
   452     "Do not manually edit this!! If it is corrupted,
   453      the MenuEditor may not be able to read the specification."
   454 
   455     "
   456      MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#toolbarMenu
   457      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication toolbarMenu)) startUp
   458     "
   459 
   460     <resource: #menu>
   461 
   462     ^ 
   463      #(Menu
   464         (
   465          (MenuItem
   466             enabled: hasSingleSelectionHolder
   467             label: 'Application'
   468             itemValue: doBrowse:
   469             translateLabel: false
   470             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
   471             argument: application
   472           )
   473          (MenuItem
   474             enabled: hasSingleSelectionHolder
   475             label: 'Application'
   476             itemValue: doInspect:
   477             translateLabel: false
   478             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
   479             argument: application
   480           )
   481          (MenuItem
   482             label: ''
   483           )
   484          (MenuItem
   485             enabled: hasSingleSelectionHolder
   486             label: 'Widget'
   487             itemValue: doBrowse:
   488             translateLabel: false
   489             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
   490             argument: view
   491           )
   492          (MenuItem
   493             enabled: hasSingleSelectionHolder
   494             label: 'Widget'
   495             itemValue: doInspect:
   496             translateLabel: true
   497             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Widget')
   498             argument: view
   499           )
   500          )
   501         nil
   502         nil
   503       )
   504 ! !
   505 
   506 !ViewTreeApplication methodsFor:'actions'!
   507 
   508 indicatorClicked:anIndex
   509     |item sensor|
   510 
   511     item := model listOfItems at:anIndex ifAbsent:nil.
   512 
   513     item notNil ifTrue:[
   514         (     (sensor := self window sensor) notNil
   515          and:[(sensor ctrlDown or:[sensor shiftDown])]
   516         ) ifTrue:[
   517             item recursiveToggleExpand
   518         ] ifFalse:[
   519             item toggleExpand
   520         ]
   521     ].
   522 ! !
   523 
   524 !ViewTreeApplication methodsFor:'aspects'!
   525 
   526 followFocusChannel
   527     "boolean holder, which indicates whether selection changed dependend on the focus view"
   528 
   529     ^ followFocusChannel
   530 !
   531 
   532 hasSingleSelectionHolder
   533     "boolean holder, true if one item is selected"
   534 
   535     ^ hasSingleSelectionHolder
   536 !
   537 
   538 hasTargetWidgetChannel
   539     "answer the channel which is set to true if a target widget exists"
   540 
   541     ^ model hasTargetWidgetChannel
   542 !
   543 
   544 listOfItems
   545     "returns the hierarchical list of items"
   546 
   547     ^ model listOfItems
   548 !
   549 
   550 model
   551     "returns my selection model, a ViewTreeModel"
   552 
   553     ^ model
   554 !
   555 
   556 selectOnClickHolder
   557     "boolean holder, which indicates whether the selection will change on click"
   558 
   559     ^ model selectOnClickHolder
   560 !
   561 
   562 showNamesHolder
   563     "boolean holder, which indicates whether application names or widget names
   564      as additional text are shown for the items"
   565 
   566     ^ showNamesHolder
   567 !
   568 
   569 testModeChannel
   570     "answer a boolean channel which describes the behaviour how to process
   571      events on the target view.
   572 
   573      false: all input events are eaten and the selection is shown on the target view.
   574      true:  no  input events are eaten and no  selection is shown on the target view."
   575 
   576     ^ model testModeChannel
   577 ! !
   578 
   579 !ViewTreeApplication methodsFor:'change & update'!
   580 
   581 selectionChanged
   582     "called if the selection changed"
   583 
   584     |info view item|
   585 
   586     item := model selectedItem.
   587 
   588     item notNil ifTrue:[ |state|
   589         view := item widget.
   590 
   591         view id isNil ifTrue:[
   592             state := 'no ID'.
   593         ] ifFalse:[
   594             view shown ifTrue:[
   595                 state := 'visible'.
   596             ] ifFalse:[
   597                 state := 'invisible'
   598             ].
   599         ].
   600         info := '%1 [%2] - %3' bindWith:(view class name)
   601                                    with:(view name ? '') with:state allBold.
   602 
   603     ] ifFalse:[
   604         info := ''
   605     ].
   606     hasSingleSelectionHolder value:(view notNil).
   607 !
   608 
   609 update:something with:someArgument from:aModel
   610     |oldSelection|
   611 
   612     aModel == showNamesHolder ifTrue:[
   613         oldSelection := model selectedItem.
   614         model selectedItem:nil.
   615         self listOfItems showWidgetNames:(aModel value).
   616         model selectedItem:oldSelection.
   617         ^ self
   618     ].
   619 
   620     aModel == model ifTrue:[
   621         self selectionChanged.
   622         ^ self
   623     ].
   624 
   625     super update:something with:someArgument from:aModel.
   626 ! !
   627 
   628 !ViewTreeApplication methodsFor:'event processing'!
   629 
   630 processButtonMotionEvent:ev
   631     "handle a button motion event"
   632 
   633     |click rootView|
   634 
   635     motionAction isNil ifTrue:[^ self].
   636 
   637     (rootView := model rootView) isNil ifTrue:[
   638         clickedItem := motionAction := nil.
   639         ^ self
   640     ].
   641 
   642     click := rootView device
   643             translatePoint:((ev x)@ (ev y))
   644             fromView:(ev view)
   645             toView:rootView.
   646 
   647     click = clickedPoint ifFalse:[
   648         (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
   649             motionAction value:click
   650         ]
   651     ].
   652 !
   653 
   654 processButtonPressEvent:ev
   655     "handle a buttopn press event"
   656 
   657     |rootView sensor lastRectangle|
   658 
   659     rootView    := model rootView.
   660     sensor      := model rootView sensor.
   661     clickedItem := model listOfItems detectItemRespondsToView:(ev view).
   662 
   663     (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
   664         clickedItem notNil ifTrue:[
   665             self selectOnClickHolder value ifTrue:[
   666                 model toggleSelectItem:clickedItem
   667             ].
   668         ].
   669         clickedItem := motionAction := nil.
   670         ^ self
   671     ].
   672 
   673     clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
   674     lastRectangle := nil.
   675 
   676     motionAction :=[:p|
   677         rootView    := model rootView device rootView.
   678         rootView    := model rootView.
   679         clickedItem := nil.
   680 
   681         rootView xoring:[
   682             lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
   683                                 ifFalse:[ rootView clippedByChildren:false ].
   684 
   685             p isNil ifTrue:[
   686                 rootView clippedByChildren:true.
   687                 motionAction := nil.
   688             ] ifFalse:[
   689                 lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
   690                 rootView displayRectangle:lastRectangle.
   691             ].
   692             rootView flush.
   693         ].
   694         lastRectangle
   695     ].
   696 !
   697 
   698 processButtonReleaseEvent:anEvent
   699     "handle a button release event"
   700 
   701     |rootView rectangle newItems widget origin|
   702 
   703     (rootView := model rootView) isNil ifTrue:[
   704         clickedItem := motionAction := nil.
   705         ^ self
   706     ].
   707     motionAction isNil ifTrue:[ ^ self ].
   708     clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
   709 
   710     rectangle := motionAction value:nil.
   711     rectangle isNil ifTrue:[^ self].
   712 
   713     newItems := OrderedCollection new.
   714 
   715     model rootItem recursiveDo:[:anItem|
   716         widget := anItem widget.
   717         origin := widget originRelativeTo:rootView.
   718 
   719         (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
   720             newItems add:anItem.
   721         ]
   722     ].
   723     model value:newItems.
   724 !
   725 
   726 processEvent:anEvent
   727     "process an event"
   728 
   729     |button menu|
   730 
   731     anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
   732     anEvent isButtonEvent  ifFalse:[ ^ self ].
   733 
   734     button := anEvent button.
   735 
   736     (button == 2 or:[button == #menu]) ifTrue:[
   737         motionAction isNil ifTrue:[
   738             anEvent isButtonPressEvent ifTrue:[
   739                 self selectOnClickHolder value ifTrue:[
   740                     menu := self middleButtonMenu value.
   741                     menu notNil ifTrue:[
   742                         menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
   743                                       receiver:self.
   744                         menu startUp.
   745                     ]
   746                 ].
   747             ].
   748             clickedItem := nil.
   749         ].
   750         ^ self
   751     ].
   752 
   753     anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].
   754     anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].
   755 
   756     anEvent isButtonReleaseEvent ifTrue:[
   757         self selectOnClickHolder value ifTrue:[
   758             self processButtonReleaseEvent:anEvent
   759         ].
   760     ].
   761     clickedItem := motionAction := nil.
   762 
   763     anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
   764         self selectOnClickHolder value ifTrue:[
   765             self doInspect:#view.
   766         ].
   767     ].
   768 !
   769 
   770 processKeyPressEvent:anEvent
   771     "process an key press event"
   772 
   773     |item prnt idx key max next|
   774 
   775     key := anEvent key.
   776     key isSymbol ifFalse:[^ self].
   777 
   778     key == #Delete    ifTrue:[ ^ self doDestroy ].
   779     key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
   780 
   781     (   key == #CursorUp
   782     or:[key == #CursorDown
   783     or:[key == #CursorLeft
   784     or:[key == #CursorRight]]]
   785     ) ifFalse:[
   786         ^ self
   787     ].
   788     item := model selectedItem.
   789 
   790     item isNil ifTrue:[
   791         ^ model selectedItem:(model first ? model rootItem)
   792     ].
   793 
   794     prnt := item parent.
   795     prnt isNil ifTrue:[
   796         "/ is the root item
   797         (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
   798                                                   ifFalse:[item := item at:1 ifAbsent:item].
   799 
   800       ^ model selectedItem:item
   801     ].
   802     key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
   803 
   804     key == #CursorRight ifTrue:[
   805         next := item at:1 ifAbsent:nil.
   806         next notNil ifTrue:[ model selectedItem:next ].
   807       ^ self
   808     ].
   809 
   810     max := prnt size.
   811 
   812     key == #CursorUp ifTrue:[
   813         idx := prnt identityIndexOf:item.
   814         idx == 1 ifTrue:[idx := max + 1].
   815         model selectedItem:(prnt at:idx - 1).
   816       ^ self.
   817     ].
   818 
   819     key == #CursorDown ifTrue:[
   820         idx := prnt identityIndexOf:item.
   821         idx == max ifTrue:[idx := 0].
   822         model selectedItem:(prnt at:idx + 1).
   823       ^ self.
   824     ].
   825 !
   826 
   827 processMappedView:aView
   828     "process a mapped event"
   829 
   830     |parent anchor|
   831 
   832     parent := self listOfItems detectItemRespondsToView:aView.
   833     parent isNil ifTrue:[ ^ self ].
   834 
   835     NotFoundSignal handle:[:ex|
   836         "contained subvies used by spec are not yet created;
   837          thus we have to wait until last used subview is build
   838         "
   839         anchor := nil.
   840     ] do:[
   841         anchor := parent class buildViewsFrom:(parent widget).
   842     ].
   843     anchor notNil ifTrue:[
   844         parent updateFromChildren:anchor children.
   845     ].
   846 ! !
   847 
   848 !ViewTreeApplication methodsFor:'initialization & release'!
   849 
   850 closeDownViews
   851     "release the grapped application"
   852 
   853     process := nil.
   854     super closeDownViews.
   855     self doUnpick.
   856 !
   857 
   858 initialize
   859     "setup my model and channels"
   860 
   861     super initialize.
   862 
   863     hasSingleSelectionHolder := false asValue.
   864     followFocusChannel       := false asValue.
   865 
   866     model := ViewTreeModel new.
   867     model inputEventAction:[:ev| self processEvent:ev ].
   868     model mappedViewAction:[:vw| self processMappedView:vw ].
   869     model application:self.
   870     model addDependent:self.
   871 
   872 
   873     showNamesHolder := false asValue.
   874     showNamesHolder addDependent:self.
   875 !
   876 
   877 postBuildTree:aTree
   878     treeView := aTree scrolledView.
   879     treeView hasConstantHeight:true.
   880 ! !
   881 
   882 !ViewTreeApplication methodsFor:'menu queries'!
   883 
   884 hasApplication
   885     "returns true if the current selected view has an application"
   886 
   887     |view|
   888 
   889     view := self selectedView.
   890   ^ (view notNil and:[view application notNil])
   891 !
   892 
   893 hasController
   894     "returns true if the current selected item's view has a controller
   895      other than nil or the view itself"
   896 
   897     |view controller|
   898 
   899     view := self selectedView.
   900 
   901     view notNil ifTrue:[
   902         controller := view controller.
   903       ^ (controller notNil and:[controller ~~ view])
   904     ].
   905     ^ false
   906 !
   907 
   908 hasModel
   909     "returns true if the current selected view has a model"
   910 
   911     |view|
   912 
   913     view := self selectedView.
   914   ^ (view notNil and:[view model notNil])
   915 ! !
   916 
   917 !ViewTreeApplication methodsFor:'menu specs'!
   918 
   919 middleButtonMenu
   920     "returns the middleButton menu for the single selected item or nil"
   921 
   922     ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
   923                                  ifFalse:[nil]
   924       ]
   925 !
   926 
   927 submenuApplications:aMenu
   928     |applications menu item list addBlock|
   929 
   930     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
   931                                               ifFalse:[model rootItem].
   932     item isNil ifTrue:[^ nil].
   933 
   934     applications := IdentityDictionary new.
   935 
   936     addBlock := [:el| |cls ctr|
   937         cls := self resolveApplicationClassFor:el.
   938 
   939         cls notNil ifTrue:[
   940             ctr := applications at:cls ifAbsent:0.
   941             applications at:cls put:(ctr + 1).
   942         ].
   943     ].
   944     item recursiveDo:addBlock.
   945     addBlock value:item.
   946 
   947     applications isEmpty ifTrue:[^ nil ].
   948     list := SortedCollection sortBlock:[:a :b| a title < b title ].
   949 
   950     applications keysAndValuesDo:[:cls :ctr|
   951        list add:(MenuDesc title:(cls name)
   952                           value:(ctr printString)
   953                          action:[self doSelectNextOfApplicationClass:cls startingIn:item]
   954                  ).
   955     ].
   956 
   957     menu := MenuDesc buildFromList:list onGC:aMenu.
   958     menu do:[:el|
   959         el hideMenuOnActivated:false
   960     ].
   961     ^ menu
   962 !
   963 
   964 submenuComponents:aMenu
   965     |widgets list total menu item|
   966 
   967     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
   968                                               ifFalse:[model rootItem].
   969     item isNil ifTrue:[^ nil].
   970 
   971     widgets := IdentityDictionary new.
   972     total   := 0.
   973 
   974     item recursiveDo:[:el| |cls ctr|
   975         cls := el widget.
   976 
   977         cls notNil ifTrue:[
   978             cls := cls class.
   979             ctr := widgets at:cls ifAbsent:0.
   980             widgets at:cls put:(ctr + 1).
   981             total := total + 1.
   982         ].
   983     ].
   984     total == 0 ifTrue:[^ nil].
   985     list := SortedCollection sortBlock:[:a :b| a title < b title ].
   986 
   987     widgets keysAndValuesDo:[:cls :ctr|
   988         list add:(MenuDesc title:(cls name)
   989                            value:(ctr printString)
   990                           action:[self doSelectNextOfClass:cls startingIn:item]
   991                  ).
   992     ].
   993     list := list asOrderedCollection.
   994     list add:(MenuDesc separator).
   995     list add:(MenuDesc title:'Total' value:(total printString)).
   996     menu := MenuDesc buildFromList:list onGC:aMenu.
   997     menu do:[:el|
   998         el hideMenuOnActivated:false
   999     ].
  1000     ^ menu
  1001 !
  1002 
  1003 submenuGeometry:aMenu
  1004     "builds and returns the geometry submenu"
  1005 
  1006     |view point inst list x y|
  1007 
  1008     view := self selectedView.
  1009     view isNil ifTrue:[^ nil].
  1010 
  1011     list := OrderedCollection new.
  1012 
  1013     "/ origin
  1014     point := view relativeOrigin.
  1015     point isNil ifTrue:[ point := view origin ].
  1016 
  1017     x := view left.
  1018     y := view top.
  1019 
  1020     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1021                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1022 
  1023     list add:(MenuDesc title:'origin' value:inst).
  1024 
  1025     "/ corner
  1026     point := view relativeCorner.
  1027     point isNil ifTrue:[ point := view corner ].
  1028 
  1029     x := view right.
  1030     y := view bottom.
  1031 
  1032     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1033                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1034 
  1035     list add:(MenuDesc title:'corner' value:inst).
  1036 
  1037     "/ extent
  1038     (point := view relativeExtent) isNil ifTrue:[point := view extent].
  1039     list add:(MenuDesc title:'extent' value:point).
  1040 
  1041     "/ preferred extent
  1042     list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
  1043     list add:(MenuDesc separator).
  1044 
  1045     "/ view insets
  1046     inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
  1047                                          with:(view rightInset)
  1048                                          with:(view topInset)
  1049                                          with:(view bottomInset).
  1050 
  1051     list add:(MenuDesc title:'insets'      value:inst).
  1052     list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
  1053     list add:(MenuDesc title:'level'       value:(view level)).
  1054     list add:(MenuDesc separator).
  1055 
  1056     (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
  1057     list add:(MenuDesc title:'layout' value:inst).
  1058 
  1059     (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
  1060     list add:(MenuDesc title:'transformation' value:inst).
  1061 
  1062   ^ MenuDesc buildFromList:list onGC:aMenu
  1063 !
  1064 
  1065 submenuInspector:aMenu
  1066     "builds and returns the inspector submenu"
  1067 
  1068     |view list n names label value|
  1069 
  1070     view := self selectedView.
  1071     view isNil ifTrue:[^ nil].
  1072 
  1073     n := view class instSize.
  1074     n > 0 ifFalse:[^ nil ].
  1075 
  1076     list  := OrderedCollection new:n.
  1077     names := view class allInstVarNames.
  1078 
  1079     1 to:n do:[:i| |action|
  1080         label := (names at:i) printString.
  1081         value := view instVarAt:i.
  1082         value isNil ifTrue:[
  1083             value  := '------'.
  1084             action := nil.
  1085         ] ifFalse:[
  1086             value  := value displayString contractAtEndTo:40.
  1087             action := [(view instVarAt:i) inspect].
  1088         ].
  1089         list add:(MenuDesc title:label value:value action:action).
  1090     ].
  1091 
  1092     ^ MenuDesc buildFromList:list onGC:aMenu
  1093 !
  1094 
  1095 submenuInterface:aMenu
  1096     "builds and returns the interface submenu"
  1097 
  1098     |view label inst value list|
  1099 
  1100     view := self selectedView.
  1101     view isNil ifTrue:[^ nil].
  1102 
  1103     list := OrderedCollection new.
  1104 
  1105     inst  := view controller.
  1106     value := nil.
  1107 
  1108     inst isNil ifTrue:[
  1109         label := nil
  1110     ] ifFalse:[
  1111         inst == view ifTrue:[ label := '== view itself' ]
  1112                     ifFalse:[ label := inst displayString.
  1113                               value := [view controller inspect].
  1114                             ].
  1115     ].
  1116     list add:(MenuDesc title:'controller' value:label action:value).
  1117 
  1118     inst := view delegate.
  1119     inst notNil ifTrue:[
  1120         list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
  1121     ].
  1122 
  1123     inst := view application.
  1124 
  1125     inst notNil ifTrue:[ |topAppl|
  1126         list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
  1127 
  1128         topAppl := inst topApplication.
  1129 
  1130         (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
  1131             list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
  1132         ].
  1133     ].
  1134     list add:(MenuDesc separator).
  1135 
  1136     (view respondsTo:#'model:') ifTrue:[
  1137         inst := model.
  1138 
  1139         inst isNil ifTrue:[ label := value := nil ]
  1140                   ifFalse:[ label := inst displayString.
  1141                             value := [ view model inspect ].
  1142                           ].
  1143 
  1144         list add:(MenuDesc title:'model' value:label action:value).
  1145 
  1146         (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
  1147             view modelInterface keysAndValuesDo:[:key : val|
  1148                 val isNil ifTrue:[ label := nil ]
  1149                          ifFalse:[ label := val displayString ].
  1150 
  1151                 list add:(MenuDesc title:('      - ', key) value:label ).
  1152             ]
  1153         ].
  1154     ].
  1155 
  1156     (view respondsTo:#enableChannel) ifTrue:[
  1157         inst := view enableChannel.
  1158 
  1159         inst isNil ifTrue:[ label := value := nil ]
  1160                   ifFalse:[ label := inst displayString.
  1161                             value := [ view enableChannel inspect ].
  1162                           ].
  1163 
  1164         list add:(MenuDesc title:'enableChannel' value:label action:value).
  1165     ].
  1166 
  1167     list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
  1168 
  1169     (view respondsTo:#listHolder) ifTrue:[
  1170         inst := view listHolder.
  1171 
  1172         inst isNil ifTrue:[ label := value := nil ]
  1173                   ifFalse:[ label := inst class printString.
  1174                             value := [ view listHolder inspect ].
  1175                           ].
  1176         list add:(MenuDesc title:'listHolder' value:label action:value).
  1177     ].
  1178 
  1179     (view respondsTo:#list) ifTrue:[
  1180         inst := view list.
  1181 
  1182         inst isNil ifTrue:[ label := value := nil ]
  1183                   ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
  1184                             value := [ view list inspect ].
  1185                           ].
  1186 
  1187         list add:(MenuDesc title:'list' value:label action:value).
  1188     ].
  1189 
  1190     list last isSeparator ifTrue:[ list removeLast ].
  1191   ^ MenuDesc buildFromList:list onGC:aMenu
  1192 !
  1193 
  1194 submenuVisibility:aMenu
  1195     "builds and returns the geometry submenu"
  1196 
  1197     |view list value|
  1198 
  1199     view := self selectedView.
  1200     view isNil ifTrue:[^ nil].
  1201 
  1202     list := OrderedCollection new.
  1203 
  1204     list add:(MenuDesc title:'device'     value:(view device printString)).
  1205     list add:(MenuDesc title:'drawableId' value:(view id)).
  1206     list add:(MenuDesc title:'gcId'       value:(view gcId)).
  1207 
  1208     list add:(MenuDesc separator).
  1209 
  1210     list add:(MenuDesc title:'shown'    value:(view shown)).
  1211     list add:(MenuDesc title:'realized' value:(view realized)).
  1212 
  1213     list add:(MenuDesc separator).
  1214 
  1215     list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
  1216 
  1217     (value := view visibilityChannel) isNil ifTrue:[
  1218         list add:(MenuDesc title:'visibilityChannel' value:'------').
  1219     ] ifFalse:[
  1220         list add:(MenuDesc title:'visibilityChannel'
  1221                            value:(value displayString)
  1222                           action:[view visibilityChannel inspect]).
  1223     ].
  1224 
  1225         
  1226   ^ MenuDesc buildFromList:list onGC:aMenu
  1227 ! !
  1228 
  1229 !ViewTreeApplication methodsFor:'private'!
  1230 
  1231 selectFocusView
  1232     |rootView focusItem focusView|
  1233 
  1234     rootView := model rootView.
  1235 
  1236     (rootView notNil and:[rootView shown]) ifTrue:[
  1237         focusView := rootView windowGroup focusView.
  1238     ].
  1239     focusView isNil ifTrue:[^ self ].
  1240 
  1241     focusItem := model selectedItem.
  1242 
  1243     (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
  1244         ^ self
  1245     ].
  1246     focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
  1247 
  1248     focusItem notNil ifTrue:[
  1249         model selectItem:focusItem.
  1250     ].        
  1251 !
  1252 
  1253 setRootItem:aRootItemOrNil
  1254     |theProcess|
  1255 
  1256     aRootItemOrNil isNil ifTrue:[
  1257         process := nil.
  1258     ] ifFalse:[
  1259         "/ expand tree to level 3
  1260         aRootItemOrNil do:[:aRootChild|
  1261             aRootChild do:[:aSubChild| aSubChild expand ].
  1262             aRootChild expand.
  1263         ].
  1264         aRootItemOrNil expand.
  1265 
  1266         process isNil ifTrue:[
  1267             theProcess := process :=
  1268                 Process for:[   |update testModeChannel|
  1269 
  1270                                 update := false.
  1271                                 testModeChannel := model testModeChannel.
  1272 
  1273                                 [process == theProcess] whileTrue:[
  1274                                     Delay waitForSeconds:0.5.
  1275 
  1276                                     (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
  1277                                         (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
  1278                                             self selectFocusView.
  1279                                         ].
  1280                                         update ifTrue:[
  1281                                             self updateShownStatus.
  1282                                         ].
  1283                                         update := update not.
  1284                                     ].
  1285                                 ].
  1286 
  1287                              ] priority:8.
  1288             theProcess name:'ViewTreeApplication::Follow Focus'.
  1289             theProcess resume.
  1290         ].
  1291     ].
  1292     model rootItem:aRootItemOrNil.
  1293 !
  1294 
  1295 updateShownStatus
  1296     |rootItem min max visState listIdx visY0 visY1 height damage|
  1297 
  1298     rootItem := model rootItem.
  1299     (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
  1300 
  1301     max := 0.
  1302     min := 9999999.
  1303 
  1304     rootItem recursiveEachVisibleItemDo:[:anItem|
  1305         visState := (anItem widget shown).
  1306 
  1307         visState ~~ anItem isDrawnShown ifTrue:[
  1308             anItem isDrawnShown:visState.
  1309             listIdx := treeView identityIndexOf:anItem.
  1310 
  1311             listIdx > 0 ifTrue:[    
  1312                 max := max max:listIdx.
  1313                 min := min min:listIdx.
  1314             ].
  1315         ].
  1316     ].
  1317     max < min ifTrue:[^ self].
  1318     max := max + 1.
  1319 
  1320     visY0  := (treeView yVisibleOfLine:min) max:0.
  1321     visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
  1322     height := visY1 - visY0.
  1323     
  1324     height > 2 ifTrue:[
  1325         treeView shown ifTrue:[
  1326             damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
  1327             treeView invalidateDeviceRectangle:damage repairNow:false.
  1328         ].
  1329     ].
  1330 ! !
  1331 
  1332 !ViewTreeApplication methodsFor:'selection'!
  1333 
  1334 selectedView
  1335     "answer the selected view or nil"
  1336 
  1337     |item|
  1338 
  1339     item := model selectedItem.
  1340     item notNil ifTrue:[ ^ item widget ].
  1341   ^ nil
  1342 ! !
  1343 
  1344 !ViewTreeApplication methodsFor:'testing'!
  1345 
  1346 resolveApplicationClassFor:aTreeItem
  1347     aTreeItem isApplicationClass ifTrue:[
  1348        ^ aTreeItem applicationClass
  1349     ].
  1350     ^ nil
  1351 !
  1352 
  1353 selectedComponentHasChildren
  1354     |item|
  1355 
  1356     item := model selectedItem.
  1357     ^ (item notNil and:[item hasChildren])
  1358 ! !
  1359 
  1360 !ViewTreeApplication methodsFor:'user operations'!
  1361 
  1362 doBrowse:what
  1363     "open browser on:
  1364         #view           browse class
  1365         #model          browse model class
  1366         #application    browse application class
  1367         #controller     browse controller class
  1368     "
  1369     |view inst|
  1370 
  1371     view := self selectedView.
  1372     view isNil ifTrue:[^ self].
  1373 
  1374              what == #view        ifTrue:[ inst := view ]
  1375     ifFalse:[what == #model       ifTrue:[ inst := view model ]
  1376     ifFalse:[what == #application ifTrue:[ inst := view application ]
  1377     ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
  1378     ifFalse:[
  1379         ^ self
  1380     ]]]].
  1381 
  1382     inst notNil ifTrue:[
  1383         inst class browserClass openInClass:(inst class) selector:nil
  1384     ].
  1385 !
  1386 
  1387 doDestroy
  1388     "destroy the current selected view"
  1389 
  1390     |item parent|
  1391 
  1392     item := model selectedItem.
  1393     item isNil ifTrue:[ ^ self].
  1394 
  1395     parent := item parent.
  1396 
  1397     parent isNil ifTrue:[
  1398         "/ the root
  1399         model withSelectionHiddenDo:[item deleteAll].
  1400       ^ self
  1401     ].
  1402 
  1403     model withSelectionHiddenDo:[
  1404         |idx nsel|
  1405 
  1406         idx := parent identityIndexOf:item.
  1407 
  1408         idx == parent size ifTrue:[
  1409             nsel := parent at:(idx - 1) ifAbsent:parent
  1410         ] ifFalse:[
  1411             nsel := parent at:(idx + 1)
  1412         ].
  1413         model setValue:nil.
  1414         item delete.
  1415 
  1416         parent isLayoutContainer ifTrue:[
  1417             parent widget sizeChanged:nil
  1418         ].
  1419         model value:nsel.
  1420     ].
  1421 !
  1422 
  1423 doFlash
  1424     "flash the selected view"
  1425 
  1426     |view|
  1427 
  1428     view := self selectedView.
  1429     view isNil ifTrue:[ ^ self].
  1430 
  1431     view shown ifTrue:[
  1432         model withSelectionHiddenDo:[
  1433             view perform:#flash ifNotUnderstood:nil.
  1434         ].
  1435     ].
  1436 !
  1437 
  1438 doInspect:what
  1439     "open inspector on:
  1440         #view           inspect class
  1441         #group          inspect windowGroup
  1442         #model          inspect model
  1443         #application    inspect application
  1444         #controller     inspect controller
  1445     "
  1446     |inst|
  1447 
  1448     inst := self selectedView.
  1449     inst isNil ifTrue:[^ self].
  1450 
  1451              what == #group       ifTrue:[ inst := inst windowGroup ]
  1452     ifFalse:[what == #model       ifTrue:[ inst := inst model ]
  1453     ifFalse:[what == #application ifTrue:[ inst := inst application ]
  1454     ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
  1455 
  1456     inst notNil ifTrue:[ inst inspect ].
  1457 !
  1458 
  1459 doPickViews
  1460     "pick a window's topView"
  1461 
  1462     |window|
  1463 
  1464     self doUnpick.
  1465 
  1466     window := Screen current viewFromUser.
  1467     window isNil ifTrue:[^ self].
  1468 
  1469     window := window topView.
  1470 
  1471     (    window == Screen current rootView
  1472      or:[window == self window topView]
  1473     ) ifTrue:[
  1474         ^ self
  1475     ].
  1476     self setRootItem:(ViewTreeItem buildViewsFrom:window).
  1477 !
  1478 
  1479 doSelectNextOfApplicationClass:aClass startingIn:anItem
  1480     |startItem firstFound searchNext|
  1481 
  1482     startItem  := model last.
  1483     searchNext := startItem notNil.        
  1484     firstFound := nil.
  1485 
  1486     anItem recursiveDo:[:el|
  1487         el == startItem ifTrue:[
  1488             searchNext := false
  1489         ] ifFalse:[
  1490             (self resolveApplicationClassFor:el) == aClass ifTrue:[
  1491                 searchNext ifFalse:[^ model selectItem:el].
  1492 
  1493                 firstFound isNil ifTrue:[
  1494                     firstFound := el
  1495                 ]
  1496             ]
  1497         ]
  1498     ].
  1499     firstFound notNil ifTrue:[
  1500         self window beep.
  1501         model selectItem:firstFound
  1502     ].
  1503 !
  1504 
  1505 doSelectNextOfClass:aClass startingIn:anItem
  1506     |startItem firstFound searchNext|
  1507 
  1508     startItem  := model last.
  1509     searchNext := startItem notNil.        
  1510     firstFound := nil.
  1511 
  1512     anItem recursiveDo:[:el|
  1513         el == startItem ifTrue:[
  1514             searchNext := false
  1515         ] ifFalse:[
  1516             el widget class == aClass ifTrue:[
  1517                 searchNext ifFalse:[^ model selectItem:el].
  1518 
  1519                 firstFound isNil ifTrue:[
  1520                     firstFound := el
  1521                 ]
  1522             ]
  1523         ]
  1524     ].
  1525     firstFound notNil ifTrue:[
  1526         self window beep.
  1527         model selectItem:firstFound
  1528     ].
  1529 !
  1530 
  1531 doUnpick
  1532     "release current picked window and contained subwindows"
  1533 
  1534     self setRootItem:nil.
  1535 ! !
  1536 
  1537 !ViewTreeApplication::MenuDesc class methodsFor:'building'!
  1538 
  1539 buildFromList:aList onGC:aMenu
  1540     |tabSpec menu w menuPanel|
  1541 
  1542     w := 0.
  1543     aList do:[:el| w := w max:(el widthOn:aMenu) ].
  1544 
  1545     tabSpec := TabulatorSpecification new.
  1546     tabSpec unit:#pixel.
  1547     tabSpec positions:#(0     1.5 ).
  1548     tabSpec align:#(#left #left).
  1549 
  1550     w := w + 15.
  1551     tabSpec positions:(Array with:0 with:w).
  1552 
  1553     menu := Menu new.
  1554 
  1555     aList do:[:el|
  1556         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
  1557     ].
  1558     menuPanel := MenuPanel menu:menu.
  1559     ^ menuPanel
  1560 ! !
  1561 
  1562 !ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!
  1563 
  1564 separator
  1565     ^ self new
  1566 !
  1567 
  1568 title:aTitle value:aValue
  1569     ^ self title:aTitle value:aValue action:nil
  1570 !
  1571 
  1572 title:aTitle value:aValue action:anAction
  1573     ^ self new title:aTitle value:aValue action:anAction
  1574 ! !
  1575 
  1576 !ViewTreeApplication::MenuDesc methodsFor:'accessing'!
  1577 
  1578 title
  1579     ^ title
  1580 ! !
  1581 
  1582 !ViewTreeApplication::MenuDesc methodsFor:'building'!
  1583 
  1584 asMenuItemWithTabulatorSpecification:aTabSpec
  1585     |array|
  1586 
  1587     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
  1588 
  1589     array := Array with:(title, ':') with:'------'.
  1590 
  1591     value notNil ifTrue:[
  1592         array at:2 put:(value printString, ' ')
  1593     ].
  1594 
  1595   ^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
  1596              value:action
  1597 ! !
  1598 
  1599 !ViewTreeApplication::MenuDesc methodsFor:'instance creation'!
  1600 
  1601 title:aTitle value:aValue action:anAction
  1602     "test for separator
  1603     "
  1604     title  := aTitle withoutSeparators.
  1605     action := anAction.
  1606 
  1607     aValue notNil ifTrue:[
  1608         value := aValue printString.
  1609 
  1610         value size > 70 ifTrue:[
  1611             value := value copyFrom:1 to:70.
  1612             value := value, '...'
  1613         ]
  1614     ].
  1615 ! !
  1616 
  1617 !ViewTreeApplication::MenuDesc methodsFor:'queries'!
  1618 
  1619 isSeparator
  1620     ^ title isNil
  1621 !
  1622 
  1623 widthOn:aGC
  1624     title isNil ifTrue:[^ 5].  "/ separator
  1625   ^ title widthOn:aGC
  1626 ! !
  1627 
  1628 !ViewTreeApplication class methodsFor:'documentation'!
  1629 
  1630 version
  1631     ^ '$Header$'
  1632 ! !
  1633 
  1634 ViewTreeApplication initialize!