Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Thu, 22 Oct 2009 21:51:10 +0200
changeset 2663 f5ce02d58661
parent 2458 64d8f3c973b3
child 2744 5bee95e91ffd
permissions -rw-r--r--
added: #aboutIcon #aboutImage

"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

ApplicationModel subclass:#ViewTreeApplication
	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
		motionAction process followFocusChannel showNamesHolder'
	classVariableNames:''
	poolDictionaries:''
	category:'A-Views-Support'
!

Object subclass:#MenuDesc
	instanceVariableNames:'title value action'
	classVariableNames:''
	poolDictionaries:''
	privateIn:ViewTreeApplication
!

!ViewTreeApplication class methodsFor:'documentation'!

documentation
"
     Small application showing a ViewTreeModel use.

     It displays a hierarchical list of a selected TopView and
     all its contained subViews.
     Useful to have a look at subcomponents - to see how views
     are structured.


    [Instance variables:]
        model           <ViewTreeModel>      the used ViewTreeModel
        clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
        clickedPoint    <Point>              point where the motion action started from.
        motionAction    <Action>             (oneArg-) action called durring buttonMotion.


    [author:]
        Claus Atzkern

    [see also:]
        ViewTreeModel
        ViewTreeItem
"
! !

!ViewTreeApplication class methodsFor:'initialization'!

initialize
    "add myself to the launcher menu
    "
    self installInLauncher.
!

installInLauncher
    "add myself to the launcher menu
    "
    |menuItem icon|

    NewLauncher isNil ifTrue:[^ self].

    icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.

    menuItem := MenuItem new 
                    label: 'View Inspector';
                    value: [ ViewTreeApplication open];
                    isButton: true;
                    icon: icon;
                    nameKey: #viewInspect.

    menuItem startGroup:#right.
    NewLauncher addMenuItem:menuItem in:'toolbar'
                   position:#( #before #help)
                      space:false.

"
self installInLauncher
self removeFromLauncher
"
!

postAutoload
    "add myself to the launcher menu
    "
    self installInLauncher.
"
self installInLauncher
self removeFromLauncher
"
!

removeFromLauncher
    "remove myself from the launcher menu
    "
    NewLauncher isNil ifTrue:[^ self].
    NewLauncher removeUserTool:#viewInspect

"
self installInLauncher
self removeFromLauncher
"
!

unload
    "class is about to be unloaded - remove myself from the launcher menu
    "
    self removeFromLauncher.
    super unload.
! !

!ViewTreeApplication class methodsFor:'interface specs'!

windowSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::ViewTreeApplication andSelector:#windowSpec
     Tools::ViewTreeApplication new openInterface:#windowSpec
     Tools::ViewTreeApplication open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'ViewTreeInspector'
          name: 'ViewTreeInspector'
          min: (Point 10 10)
          max: (Point 1024 9999)
          bounds: (Rectangle 0 0 381 654)
          menu: menu
        )
        component: 
       (SpecCollection
          collection: (
           (MenuPanelSpec
              name: 'toolbarMenu'
              layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)
              menu: toolbarMenu
              textDefault: true
            )
           (HierarchicalListViewSpec
              name: 'List'
              layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 0 1.0)
              level: 1
              model: model
              menu: middleButtonMenu
              hasHorizontalScrollBar: true
              hasVerticalScrollBar: true
              miniScrollerHorizontal: true
              miniScrollerVertical: false
              listModel: listOfItems
              multipleSelectOk: true
              useIndex: false
              highlightMode: label
              showLeftIndicators: false
              indicatorSelector: indicatorClicked:
              useDefaultIcons: false
              postBuildCallback: postBuildTree:
            )
           )
         
        )
      )
! !

!ViewTreeApplication class methodsFor:'menu specs'!

menu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'File'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Pick a View'
                  itemValue: doPickViews
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasTargetWidgetChannel
                  label: 'Release Picked View'
                  itemValue: doUnpick
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Exit'
                  itemValue: closeRequest
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Settings'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Test Mode'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: testModeChannel
                )
               (MenuItem
                  enabled: testModeChannel
                  label: 'Follow Focus'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: followFocusChannel
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Select on Click'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: selectOnClickHolder
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Show Name of Widgets'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showNamesHolder
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: ''
          )
         (MenuItem
            enabled: hasSingleSelectionHolder
            label: 'Menu'
            translateLabel: true
            submenuChannel: middleButtonMenu
          )
         (MenuItem
            enabled: hasTargetWidgetChannel
            label: 'Components'
            translateLabel: true
            startGroup: right
            submenuChannel: submenuComponents:
          )
         (MenuItem
            enabled: hasTargetWidgetChannel
            label: 'Applications'
            translateLabel: true
            submenuChannel: submenuApplications:
          )
         )
        nil
        nil
      )
!

middleButtonMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
     (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Geometry'
            translateLabel: true
            submenuChannel: submenuGeometry:
            keepLinkedMenu: true
          )
         (MenuItem
            label: 'Interface'
            translateLabel: true
            submenuChannel: submenuInterface:
            keepLinkedMenu: true
          )
         (MenuItem
            label: 'Visibility'
            translateLabel: true
            submenuChannel: submenuVisibility:
            keepLinkedMenu: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Browse View Class'
            itemValue: doBrowse:
            translateLabel: true
            argument: view
          )
         (MenuItem
            label: 'Browse Model Class'
            itemValue: doBrowse:
            translateLabel: true
            isVisible: hasModel
            argument: model
          )
         (MenuItem
            label: 'Browse Application Class'
            itemValue: doBrowse:
            translateLabel: true
            isVisible: hasApplication
            argument: application
          )
         (MenuItem
            label: 'Browse Controller Class'
            itemValue: doBrowse:
            translateLabel: true
            isVisible: hasController
            argument: controller
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Inspect View'
            itemValue: doInspect:
            translateLabel: true
            argument: view
          )
         (MenuItem
            label: 'Inspect Window Group'
            itemValue: doInspect:
            translateLabel: true
            argument: group
          )
         (MenuItem
            label: 'Inspect Model'
            itemValue: doInspect:
            translateLabel: true
            isVisible: hasModel
            argument: model
          )
         (MenuItem
            label: 'Inspect Application'
            itemValue: doInspect:
            translateLabel: true
            isVisible: hasApplication
            argument: application
          )
         (MenuItem
            label: 'Inspect Controller'
            itemValue: doInspect:
            translateLabel: true
            isVisible: hasController
            argument: controller
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Flash'
            itemValue: doFlash
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Destroy'
            itemValue: doDestroy
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Instance Variables'
            translateLabel: true
            submenuChannel: submenuInspector:
            keepLinkedMenu: true
          )
         (MenuItem
            label: '='
          )
         (MenuItem
            label: ''
          )
         (MenuItem
            enabled: selectedComponentHasChildren
            label: 'Applications'
            nameKey: single
            translateLabel: true
            submenuChannel: submenuApplications:
            keepLinkedMenu: true
          )
         (MenuItem
            enabled: selectedComponentHasChildren
            label: 'Components'
            nameKey: single
            translateLabel: true
            submenuChannel: submenuComponents:
            keepLinkedMenu: true
          )
         )
        nil
        nil
      )
!

toolbarMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#toolbarMenu
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication toolbarMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            enabled: hasSingleSelectionHolder
            label: 'Application'
            itemValue: doBrowse:
            translateLabel: false
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
            argument: application
          )
         (MenuItem
            enabled: hasSingleSelectionHolder
            label: 'Application'
            itemValue: doInspect:
            translateLabel: false
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
            argument: application
          )
         (MenuItem
            label: ''
          )
         (MenuItem
            enabled: hasSingleSelectionHolder
            label: 'Widget'
            itemValue: doBrowse:
            translateLabel: false
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
            argument: view
          )
         (MenuItem
            enabled: hasSingleSelectionHolder
            label: 'Widget'
            itemValue: doInspect:
            translateLabel: true
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Widget')
            argument: view
          )
         )
        nil
        nil
      )
! !

!ViewTreeApplication methodsFor:'actions'!

indicatorClicked:anIndex
    |item sensor|

    item := model listOfItems at:anIndex ifAbsent:nil.

    item notNil ifTrue:[
        (     (sensor := self window sensor) notNil
         and:[(sensor ctrlDown or:[sensor shiftDown])]
        ) ifTrue:[
            item recursiveToggleExpand
        ] ifFalse:[
            item toggleExpand
        ]
    ].
! !

!ViewTreeApplication methodsFor:'aspects'!

followFocusChannel
    "boolean holder, which indicates whether selection changed dependend on the focus view"

    ^ followFocusChannel
!

hasSingleSelectionHolder
    "boolean holder, true if one item is selected"

    ^ hasSingleSelectionHolder
!

hasTargetWidgetChannel
    "answer the channel which is set to true if a target widget exists"

    ^ model hasTargetWidgetChannel
!

listOfItems
    "returns the hierarchical list of items"

    ^ model listOfItems
!

model
    "returns my selection model, a ViewTreeModel"

    ^ model
!

selectOnClickHolder
    "boolean holder, which indicates whether the selection will change on click"

    ^ model selectOnClickHolder
!

showNamesHolder
    "boolean holder, which indicates whether application names or widget names
     as additional text are shown for the items"

    ^ showNamesHolder
!

testModeChannel
    "answer a boolean channel which describes the behaviour how to process
     events on the target view.

     false: all input events are eaten and the selection is shown on the target view.
     true:  no  input events are eaten and no  selection is shown on the target view."

    ^ model testModeChannel
! !

!ViewTreeApplication methodsFor:'change & update'!

selectionChanged
    "called if the selection changed"

    |info view item|

    item := model selectedItem.

    item notNil ifTrue:[ |state|
        view := item widget.

        view id isNil ifTrue:[
            state := 'no ID'.
        ] ifFalse:[
            view shown ifTrue:[
                state := 'visible'.
            ] ifFalse:[
                state := 'invisible'
            ].
        ].
        info := '%1 [%2] - %3' bindWith:(view class name)
                                   with:(view name ? '') with:state allBold.

    ] ifFalse:[
        info := ''
    ].
    hasSingleSelectionHolder value:(view notNil).
!

update:something with:someArgument from:aModel
    |oldSelection|

    aModel == showNamesHolder ifTrue:[
        oldSelection := model selectedItem.
        model selectedItem:nil.
        self listOfItems showWidgetNames:(aModel value).
        model selectedItem:oldSelection.
        ^ self
    ].

    aModel == model ifTrue:[
        self selectionChanged.
        ^ self
    ].

    super update:something with:someArgument from:aModel.
! !

!ViewTreeApplication methodsFor:'event processing'!

processButtonMotionEvent:ev
    "handle a button motion event"

    |click rootView|

    motionAction isNil ifTrue:[^ self].

    (rootView := model rootView) isNil ifTrue:[
        clickedItem := motionAction := nil.
        ^ self
    ].

    click := rootView device
            translatePoint:((ev x)@ (ev y))
            fromView:(ev view)
            toView:rootView.

    click = clickedPoint ifFalse:[
        (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
            motionAction value:click
        ]
    ].
!

processButtonPressEvent:ev
    "handle a buttopn press event"

    |rootView sensor lastRectangle|

    rootView    := model rootView.
    sensor      := model rootView sensor.
    clickedItem := model listOfItems detectItemRespondsToView:(ev view).

    (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
        clickedItem notNil ifTrue:[
            self selectOnClickHolder value ifTrue:[
                model toggleSelectItem:clickedItem
            ].
        ].
        clickedItem := motionAction := nil.
        ^ self
    ].

    clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
    lastRectangle := nil.

    motionAction :=[:p|
        rootView    := model rootView device rootView.
        rootView    := model rootView.
        clickedItem := nil.

        rootView xoring:[
            lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
                                ifFalse:[ rootView clippedByChildren:false ].

            p isNil ifTrue:[
                rootView clippedByChildren:true.
                motionAction := nil.
            ] ifFalse:[
                lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
                rootView displayRectangle:lastRectangle.
            ].
            rootView flush.
        ].
        lastRectangle
    ].
!

processButtonReleaseEvent:anEvent
    "handle a button release event"

    |rootView rectangle newItems widget origin|

    (rootView := model rootView) isNil ifTrue:[
        clickedItem := motionAction := nil.
        ^ self
    ].
    motionAction isNil ifTrue:[ ^ self ].
    clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].

    rectangle := motionAction value:nil.
    rectangle isNil ifTrue:[^ self].

    newItems := OrderedCollection new.

    model rootItem recursiveDo:[:anItem|
        widget := anItem widget.
        origin := widget originRelativeTo:rootView.

        (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
            newItems add:anItem.
        ]
    ].
    model value:newItems.
!

processEvent:anEvent
    "process an event"

    |button menu|

    anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
    anEvent isButtonEvent  ifFalse:[ ^ self ].

    button := anEvent button.

    (button == 2 or:[button == #menu]) ifTrue:[
        motionAction isNil ifTrue:[
            anEvent isButtonPressEvent ifTrue:[
                self selectOnClickHolder value ifTrue:[
                    menu := self middleButtonMenu value.
                    menu notNil ifTrue:[
                        menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
                                      receiver:self.
                        menu startUp.
                    ]
                ].
            ].
            clickedItem := nil.
        ].
        ^ self
    ].

    anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].
    anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].

    anEvent isButtonReleaseEvent ifTrue:[
        self selectOnClickHolder value ifTrue:[
            self processButtonReleaseEvent:anEvent
        ].
    ].
    clickedItem := motionAction := nil.

    anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
        self selectOnClickHolder value ifTrue:[
            self doInspect:#view.
        ].
    ].
!

processKeyPressEvent:anEvent
    "process an key press event"

    |item prnt idx key max next|

    key := anEvent key.
    key isSymbol ifFalse:[^ self].

    key == #Delete    ifTrue:[ ^ self doDestroy ].
    key == #InspectIt ifTrue:[ ^ self doInspect:#view ].

    (   key == #CursorUp
    or:[key == #CursorDown
    or:[key == #CursorLeft
    or:[key == #CursorRight]]]
    ) ifFalse:[
        ^ self
    ].
    item := model selectedItem.

    item isNil ifTrue:[
        ^ model selectedItem:(model first ? model rootItem)
    ].

    prnt := item parent.
    prnt isNil ifTrue:[
        "/ is the root item
        (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
                                                  ifFalse:[item := item at:1 ifAbsent:item].

      ^ model selectedItem:item
    ].
    key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].

    key == #CursorRight ifTrue:[
        next := item at:1 ifAbsent:nil.
        next notNil ifTrue:[ model selectedItem:next ].
      ^ self
    ].

    max := prnt size.

    key == #CursorUp ifTrue:[
        idx := prnt identityIndexOf:item.
        idx == 1 ifTrue:[idx := max + 1].
        model selectedItem:(prnt at:idx - 1).
      ^ self.
    ].

    key == #CursorDown ifTrue:[
        idx := prnt identityIndexOf:item.
        idx == max ifTrue:[idx := 0].
        model selectedItem:(prnt at:idx + 1).
      ^ self.
    ].
!

processMappedView:aView
    "process a mapped event"

    |parent anchor|

    parent := self listOfItems detectItemRespondsToView:aView.
    parent isNil ifTrue:[ ^ self ].

    NotFoundSignal handle:[:ex|
        "contained subvies used by spec are not yet created;
         thus we have to wait until last used subview is build
        "
        anchor := nil.
    ] do:[
        anchor := parent class buildViewsFrom:(parent widget).
    ].
    anchor notNil ifTrue:[
        parent updateFromChildren:anchor children.
    ].
! !

!ViewTreeApplication methodsFor:'initialization & release'!

closeDownViews
    "release the grapped application"

    process := nil.
    super closeDownViews.
    self doUnpick.
!

initialize
    "setup my model and channels"

    super initialize.

    hasSingleSelectionHolder := false asValue.
    followFocusChannel       := false asValue.

    model := ViewTreeModel new.
    model inputEventAction:[:ev| self processEvent:ev ].
    model mappedViewAction:[:vw| self processMappedView:vw ].
    model application:self.
    model addDependent:self.


    showNamesHolder := false asValue.
    showNamesHolder addDependent:self.
!

postBuildTree:aTree
    treeView := aTree scrolledView.
    treeView hasConstantHeight:true.
! !

!ViewTreeApplication methodsFor:'menu queries'!

hasApplication
    "returns true if the current selected view has an application"

    |view|

    view := self selectedView.
  ^ (view notNil and:[view application notNil])
!

hasController
    "returns true if the current selected item's view has a controller
     other than nil or the view itself"

    |view controller|

    view := self selectedView.

    view notNil ifTrue:[
        controller := view controller.
      ^ (controller notNil and:[controller ~~ view])
    ].
    ^ false
!

hasModel
    "returns true if the current selected view has a model"

    |view|

    view := self selectedView.
  ^ (view notNil and:[view model notNil])
! !

!ViewTreeApplication methodsFor:'menu specs'!

middleButtonMenu
    "returns the middleButton menu for the single selected item or nil"

    ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
                                 ifFalse:[nil]
      ]
!

submenuApplications:aMenu
    |applications menu item list addBlock|

    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
                                              ifFalse:[model rootItem].
    item isNil ifTrue:[^ nil].

    applications := IdentityDictionary new.

    addBlock := [:el| |cls ctr|
        cls := self resolveApplicationClassFor:el.

        cls notNil ifTrue:[
            ctr := applications at:cls ifAbsent:0.
            applications at:cls put:(ctr + 1).
        ].
    ].
    item recursiveDo:addBlock.
    addBlock value:item.

    applications isEmpty ifTrue:[^ nil ].
    list := SortedCollection sortBlock:[:a :b| a title < b title ].

    applications keysAndValuesDo:[:cls :ctr|
       list add:(MenuDesc title:(cls name)
                          value:(ctr printString)
                         action:[self doSelectNextOfApplicationClass:cls startingIn:item]
                 ).
    ].

    menu := MenuDesc buildFromList:list onGC:aMenu.
    menu do:[:el|
        el hideMenuOnActivated:false
    ].
    ^ menu
!

submenuComponents:aMenu
    |widgets list total menu item|

    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
                                              ifFalse:[model rootItem].
    item isNil ifTrue:[^ nil].

    widgets := IdentityDictionary new.
    total   := 0.

    item recursiveDo:[:el| |cls ctr|
        cls := el widget.

        cls notNil ifTrue:[
            cls := cls class.
            ctr := widgets at:cls ifAbsent:0.
            widgets at:cls put:(ctr + 1).
            total := total + 1.
        ].
    ].
    total == 0 ifTrue:[^ nil].
    list := SortedCollection sortBlock:[:a :b| a title < b title ].

    widgets keysAndValuesDo:[:cls :ctr|
        list add:(MenuDesc title:(cls name)
                           value:(ctr printString)
                          action:[self doSelectNextOfClass:cls startingIn:item]
                 ).
    ].
    list := list asOrderedCollection.
    list add:(MenuDesc separator).
    list add:(MenuDesc title:'Total' value:(total printString)).
    menu := MenuDesc buildFromList:list onGC:aMenu.
    menu do:[:el|
        el hideMenuOnActivated:false
    ].
    ^ menu
!

submenuGeometry:aMenu
    "builds and returns the geometry submenu"

    |view point inst list x y|

    view := self selectedView.
    view isNil ifTrue:[^ nil].

    list := OrderedCollection new.

    "/ origin
    point := view relativeOrigin.
    point isNil ifTrue:[ point := view origin ].

    x := view left.
    y := view top.

    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].

    list add:(MenuDesc title:'origin' value:inst).

    "/ corner
    point := view relativeCorner.
    point isNil ifTrue:[ point := view corner ].

    x := view right.
    y := view bottom.

    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].

    list add:(MenuDesc title:'corner' value:inst).

    "/ extent
    (point := view relativeExtent) isNil ifTrue:[point := view extent].
    list add:(MenuDesc title:'extent' value:point).

    "/ preferred extent
    list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
    list add:(MenuDesc separator).

    "/ view insets
    inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
                                         with:(view rightInset)
                                         with:(view topInset)
                                         with:(view bottomInset).

    list add:(MenuDesc title:'insets'      value:inst).
    list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
    list add:(MenuDesc title:'level'       value:(view level)).
    list add:(MenuDesc separator).

    (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
    list add:(MenuDesc title:'layout' value:inst).

    (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
    list add:(MenuDesc title:'transformation' value:inst).

  ^ MenuDesc buildFromList:list onGC:aMenu
!

submenuInspector:aMenu
    "builds and returns the inspector submenu"

    |view list n names label value|

    view := self selectedView.
    view isNil ifTrue:[^ nil].

    n := view class instSize.
    n > 0 ifFalse:[^ nil ].

    list  := OrderedCollection new:n.
    names := view class allInstVarNames.

    1 to:n do:[:i| |action|
        label := (names at:i) printString.
        value := view instVarAt:i.
        value isNil ifTrue:[
            value  := '------'.
            action := nil.
        ] ifFalse:[
            value  := value displayString contractAtEndTo:40.
            action := [(view instVarAt:i) inspect].
        ].
        list add:(MenuDesc title:label value:value action:action).
    ].

    ^ MenuDesc buildFromList:list onGC:aMenu
!

submenuInterface:aMenu
    "builds and returns the interface submenu"

    |view label inst value list|

    view := self selectedView.
    view isNil ifTrue:[^ nil].

    list := OrderedCollection new.

    inst  := view controller.
    value := nil.

    inst isNil ifTrue:[
        label := nil
    ] ifFalse:[
        inst == view ifTrue:[ label := '== view itself' ]
                    ifFalse:[ label := inst displayString.
                              value := [view controller inspect].
                            ].
    ].
    list add:(MenuDesc title:'controller' value:label action:value).

    inst := view delegate.
    inst notNil ifTrue:[
        list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
    ].

    inst := view application.

    inst notNil ifTrue:[ |topAppl|
        list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).

        topAppl := inst topApplication.

        (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
            list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
        ].
    ].
    list add:(MenuDesc separator).

    (view respondsTo:#'model:') ifTrue:[
        inst := model.

        inst isNil ifTrue:[ label := value := nil ]
                  ifFalse:[ label := inst displayString.
                            value := [ view model inspect ].
                          ].

        list add:(MenuDesc title:'model' value:label action:value).

        (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
            view modelInterface keysAndValuesDo:[:key : val|
                val isNil ifTrue:[ label := nil ]
                         ifFalse:[ label := val displayString ].

                list add:(MenuDesc title:('      - ', key) value:label ).
            ]
        ].
    ].

    (view respondsTo:#enableChannel) ifTrue:[
        inst := view enableChannel.

        inst isNil ifTrue:[ label := value := nil ]
                  ifFalse:[ label := inst displayString.
                            value := [ view enableChannel inspect ].
                          ].

        list add:(MenuDesc title:'enableChannel' value:label action:value).
    ].

    list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].

    (view respondsTo:#listHolder) ifTrue:[
        inst := view listHolder.

        inst isNil ifTrue:[ label := value := nil ]
                  ifFalse:[ label := inst class printString.
                            value := [ view listHolder inspect ].
                          ].
        list add:(MenuDesc title:'listHolder' value:label action:value).
    ].

    (view respondsTo:#list) ifTrue:[
        inst := view list.

        inst isNil ifTrue:[ label := value := nil ]
                  ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
                            value := [ view list inspect ].
                          ].

        list add:(MenuDesc title:'list' value:label action:value).
    ].

    list last isSeparator ifTrue:[ list removeLast ].
  ^ MenuDesc buildFromList:list onGC:aMenu
!

submenuVisibility:aMenu
    "builds and returns the geometry submenu"

    |view list value|

    view := self selectedView.
    view isNil ifTrue:[^ nil].

    list := OrderedCollection new.

    list add:(MenuDesc title:'device'     value:(view device printString)).
    list add:(MenuDesc title:'drawableId' value:(view id)).
    list add:(MenuDesc title:'gcId'       value:(view gcId)).

    list add:(MenuDesc separator).

    list add:(MenuDesc title:'shown'    value:(view shown)).
    list add:(MenuDesc title:'realized' value:(view realized)).

    list add:(MenuDesc separator).

    list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).

    (value := view visibilityChannel) isNil ifTrue:[
        list add:(MenuDesc title:'visibilityChannel' value:'------').
    ] ifFalse:[
        list add:(MenuDesc title:'visibilityChannel'
                           value:(value displayString)
                          action:[view visibilityChannel inspect]).
    ].

        
  ^ MenuDesc buildFromList:list onGC:aMenu
! !

!ViewTreeApplication methodsFor:'private'!

selectFocusView
    |rootView focusItem focusView|

    rootView := model rootView.

    (rootView notNil and:[rootView shown]) ifTrue:[
        focusView := rootView windowGroup focusView.
    ].
    focusView isNil ifTrue:[^ self ].

    focusItem := model selectedItem.

    (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
        ^ self
    ].
    focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].

    focusItem notNil ifTrue:[
        model selectItem:focusItem.
    ].        
!

setRootItem:aRootItemOrNil
    |theProcess|

    aRootItemOrNil isNil ifTrue:[
        process := nil.
    ] ifFalse:[
        "/ expand tree to level 3
        aRootItemOrNil do:[:aRootChild|
            aRootChild do:[:aSubChild| aSubChild expand ].
            aRootChild expand.
        ].
        aRootItemOrNil expand.

        process isNil ifTrue:[
            theProcess := process :=
                Process for:[   |update testModeChannel|

                                update := false.
                                testModeChannel := model testModeChannel.

                                [process == theProcess] whileTrue:[
                                    Delay waitForSeconds:0.5.

                                    (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
                                        (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
                                            self selectFocusView.
                                        ].
                                        update ifTrue:[
                                            self updateShownStatus.
                                        ].
                                        update := update not.
                                    ].
                                ].

                             ] priority:8.
            theProcess name:'ViewTreeApplication::Follow Focus'.
            theProcess resume.
        ].
    ].
    model rootItem:aRootItemOrNil.
!

updateShownStatus
    |rootItem min max visState listIdx visY0 visY1 height damage|

    rootItem := model rootItem.
    (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].

    max := 0.
    min := 9999999.

    rootItem recursiveEachVisibleItemDo:[:anItem|
        visState := (anItem widget shown).

        visState ~~ anItem isDrawnShown ifTrue:[
            anItem isDrawnShown:visState.
            listIdx := treeView identityIndexOf:anItem.

            listIdx > 0 ifTrue:[    
                max := max max:listIdx.
                min := min min:listIdx.
            ].
        ].
    ].
    max < min ifTrue:[^ self].
    max := max + 1.

    visY0  := (treeView yVisibleOfLine:min) max:0.
    visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
    height := visY1 - visY0.
    
    height > 2 ifTrue:[
        treeView shown ifTrue:[
            damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
            treeView invalidateDeviceRectangle:damage repairNow:false.
        ].
    ].
! !

!ViewTreeApplication methodsFor:'selection'!

selectedView
    "answer the selected view or nil"

    |item|

    item := model selectedItem.
    item notNil ifTrue:[ ^ item widget ].
  ^ nil
! !

!ViewTreeApplication methodsFor:'testing'!

resolveApplicationClassFor:aTreeItem
    aTreeItem isApplicationClass ifTrue:[
       ^ aTreeItem applicationClass
    ].
    ^ nil
!

selectedComponentHasChildren
    |item|

    item := model selectedItem.
    ^ (item notNil and:[item hasChildren])
! !

!ViewTreeApplication methodsFor:'user operations'!

doBrowse:what
    "open browser on:
        #view           browse class
        #model          browse model class
        #application    browse application class
        #controller     browse controller class
    "
    |view inst|

    view := self selectedView.
    view isNil ifTrue:[^ self].

             what == #view        ifTrue:[ inst := view ]
    ifFalse:[what == #model       ifTrue:[ inst := view model ]
    ifFalse:[what == #application ifTrue:[ inst := view application ]
    ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
    ifFalse:[
        ^ self
    ]]]].

    inst notNil ifTrue:[
        inst class browserClass openInClass:(inst class) selector:nil
    ].
!

doDestroy
    "destroy the current selected view"

    |item parent|

    item := model selectedItem.
    item isNil ifTrue:[ ^ self].

    parent := item parent.

    parent isNil ifTrue:[
        "/ the root
        model withSelectionHiddenDo:[item deleteAll].
      ^ self
    ].

    model withSelectionHiddenDo:[
        |idx nsel|

        idx := parent identityIndexOf:item.

        idx == parent size ifTrue:[
            nsel := parent at:(idx - 1) ifAbsent:parent
        ] ifFalse:[
            nsel := parent at:(idx + 1)
        ].
        model setValue:nil.
        item delete.

        parent isLayoutContainer ifTrue:[
            parent widget sizeChanged:nil
        ].
        model value:nsel.
    ].
!

doFlash
    "flash the selected view"

    |view|

    view := self selectedView.
    view isNil ifTrue:[ ^ self].

    view shown ifTrue:[
        model withSelectionHiddenDo:[
            view perform:#flash ifNotUnderstood:nil.
        ].
    ].
!

doInspect:what
    "open inspector on:
        #view           inspect class
        #group          inspect windowGroup
        #model          inspect model
        #application    inspect application
        #controller     inspect controller
    "
    |inst|

    inst := self selectedView.
    inst isNil ifTrue:[^ self].

             what == #group       ifTrue:[ inst := inst windowGroup ]
    ifFalse:[what == #model       ifTrue:[ inst := inst model ]
    ifFalse:[what == #application ifTrue:[ inst := inst application ]
    ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].

    inst notNil ifTrue:[ inst inspect ].
!

doPickViews
    "pick a window's topView"

    |window|

    self doUnpick.

    window := Screen current viewFromUser.
    window isNil ifTrue:[^ self].

    window := window topView.

    (    window == Screen current rootView
     or:[window == self window topView]
    ) ifTrue:[
        ^ self
    ].
    self setRootItem:(ViewTreeItem buildViewsFrom:window).
!

doSelectNextOfApplicationClass:aClass startingIn:anItem
    |startItem firstFound searchNext|

    startItem  := model last.
    searchNext := startItem notNil.        
    firstFound := nil.

    anItem recursiveDo:[:el|
        el == startItem ifTrue:[
            searchNext := false
        ] ifFalse:[
            (self resolveApplicationClassFor:el) == aClass ifTrue:[
                searchNext ifFalse:[^ model selectItem:el].

                firstFound isNil ifTrue:[
                    firstFound := el
                ]
            ]
        ]
    ].
    firstFound notNil ifTrue:[
        self window beep.
        model selectItem:firstFound
    ].
!

doSelectNextOfClass:aClass startingIn:anItem
    |startItem firstFound searchNext|

    startItem  := model last.
    searchNext := startItem notNil.        
    firstFound := nil.

    anItem recursiveDo:[:el|
        el == startItem ifTrue:[
            searchNext := false
        ] ifFalse:[
            el widget class == aClass ifTrue:[
                searchNext ifFalse:[^ model selectItem:el].

                firstFound isNil ifTrue:[
                    firstFound := el
                ]
            ]
        ]
    ].
    firstFound notNil ifTrue:[
        self window beep.
        model selectItem:firstFound
    ].
!

doUnpick
    "release current picked window and contained subwindows"

    self setRootItem:nil.
! !

!ViewTreeApplication::MenuDesc class methodsFor:'building'!

buildFromList:aList onGC:aMenu
    |tabSpec menu w menuPanel|

    w := 0.
    aList do:[:el| w := w max:(el widthOn:aMenu) ].

    tabSpec := TabulatorSpecification new.
    tabSpec unit:#pixel.
    tabSpec positions:#(0     1.5 ).
    tabSpec align:#(#left #left).

    w := w + 15.
    tabSpec positions:(Array with:0 with:w).

    menu := Menu new.

    aList do:[:el|
        menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
    ].
    menuPanel := MenuPanel menu:menu.
    ^ menuPanel
! !

!ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!

separator
    ^ self new
!

title:aTitle value:aValue
    ^ self title:aTitle value:aValue action:nil
!

title:aTitle value:aValue action:anAction
    ^ self new title:aTitle value:aValue action:anAction
! !

!ViewTreeApplication::MenuDesc methodsFor:'accessing'!

title
    ^ title
! !

!ViewTreeApplication::MenuDesc methodsFor:'building'!

asMenuItemWithTabulatorSpecification:aTabSpec
    |array|

    title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator

    array := Array with:(title, ':') with:'------'.

    value notNil ifTrue:[
        array at:2 put:(value printString, ' ')
    ].

  ^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
             value:action
! !

!ViewTreeApplication::MenuDesc methodsFor:'instance creation'!

title:aTitle value:aValue action:anAction
    "test for separator
    "
    title  := aTitle withoutSeparators.
    action := anAction.

    aValue notNil ifTrue:[
        value := aValue printString.

        value size > 70 ifTrue:[
            value := value copyFrom:1 to:70.
            value := value, '...'
        ]
    ].
! !

!ViewTreeApplication::MenuDesc methodsFor:'queries'!

isSeparator
    ^ title isNil
!

widthOn:aGC
    title isNil ifTrue:[^ 5].  "/ separator
  ^ title widthOn:aGC
! !

!ViewTreeApplication class methodsFor:'documentation'!

version
    ^ '$Header$'
! !

ViewTreeApplication initialize!