ca@2177: "{ Package: 'stx:libtool2' }"
ca@2177: 
ca@2177: "{ NameSpace: Tools }"
ca@2177: 
ca@2177: ApplicationModel subclass:#ViewTreeApplication
ca@2177: 	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
ca@2458: 		motionAction process followFocusChannel showNamesHolder'
ca@2177: 	classVariableNames:''
ca@2177: 	poolDictionaries:''
ca@2177: 	category:'A-Views-Support'
ca@2177: !
ca@2177: 
ca@2177: Object subclass:#MenuDesc
ca@2177: 	instanceVariableNames:'title value action'
ca@2177: 	classVariableNames:''
ca@2177: 	poolDictionaries:''
ca@2177: 	privateIn:ViewTreeApplication
ca@2177: !
ca@2177: 
ca@2177: !ViewTreeApplication class methodsFor:'documentation'!
ca@2177: 
ca@2177: documentation
ca@2177: "
ca@2177:      Small application showing a ViewTreeModel use.
ca@2177: 
ca@2177:      It displays a hierarchical list of a selected TopView and
ca@2177:      all its contained subViews.
ca@2177:      Useful to have a look at subcomponents - to see how views
ca@2177:      are structured.
ca@2177: 
ca@2177: 
ca@2177:     [Instance variables:]
ca@2177:         model           <ViewTreeModel>      the used ViewTreeModel
ca@2177:         clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
ca@2177:         clickedPoint    <Point>              point where the motion action started from.
ca@2177:         motionAction    <Action>             (oneArg-) action called durring buttonMotion.
ca@2177: 
ca@2177: 
ca@2177:     [author:]
ca@2177:         Claus Atzkern
ca@2177: 
ca@2177:     [see also:]
ca@2177:         ViewTreeModel
ca@2177:         ViewTreeItem
ca@2177: "
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication class methodsFor:'initialization'!
ca@2177: 
ca@2177: initialize
ca@2177:     "add myself to the launcher menu
ca@2177:     "
ca@2177:     self installInLauncher.
ca@2177: !
ca@2177: 
ca@2177: installInLauncher
ca@2177:     "add myself to the launcher menu
ca@2177:     "
ca@2177:     |menuItem icon|
ca@2177: 
ca@2177:     NewLauncher isNil ifTrue:[^ self].
ca@2177: 
ca@2177:     icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
ca@2177: 
ca@2177:     menuItem := MenuItem new 
ca@2177:                     label: 'View Inspector';
ca@2177:                     value: [ ViewTreeApplication open];
ca@2177:                     isButton: true;
ca@2177:                     icon: icon;
ca@2177:                     nameKey: #viewInspect.
ca@2177: 
ca@2177:     menuItem startGroup:#right.
ca@2177:     NewLauncher addMenuItem:menuItem in:'toolbar'
ca@2177:                    position:#( #before #help)
ca@2177:                       space:false.
ca@2177: 
ca@2177: "
ca@2177: self installInLauncher
ca@2177: self removeFromLauncher
ca@2177: "
ca@2177: !
ca@2177: 
ca@2177: postAutoload
ca@2177:     "add myself to the launcher menu
ca@2177:     "
ca@2177:     self installInLauncher.
ca@2177: "
ca@2177: self installInLauncher
ca@2177: self removeFromLauncher
ca@2177: "
ca@2177: !
ca@2177: 
ca@2177: removeFromLauncher
ca@2177:     "remove myself from the launcher menu
ca@2177:     "
ca@2177:     NewLauncher isNil ifTrue:[^ self].
ca@2177:     NewLauncher removeUserTool:#viewInspect
ca@2177: 
ca@2177: "
ca@2177: self installInLauncher
ca@2177: self removeFromLauncher
ca@2177: "
ca@2177: !
ca@2177: 
ca@2177: unload
ca@2177:     "class is about to be unloaded - remove myself from the launcher menu
ca@2177:     "
ca@2177:     self removeFromLauncher.
ca@2177:     super unload.
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication class methodsFor:'interface specs'!
ca@2177: 
ca@2177: windowSpec
ca@2177:     "This resource specification was automatically generated
ca@2177:      by the UIPainter of ST/X."
ca@2177: 
ca@2177:     "Do not manually edit this!! If it is corrupted,
ca@2177:      the UIPainter may not be able to read the specification."
ca@2177: 
ca@2177:     "
ca@2451:      UIPainter new openOnClass:Tools::ViewTreeApplication andSelector:#windowSpec
ca@2451:      Tools::ViewTreeApplication new openInterface:#windowSpec
ca@2451:      Tools::ViewTreeApplication open
ca@2177:     "
ca@2177: 
ca@2177:     <resource: #canvas>
ca@2177: 
ca@2177:     ^ 
ca@2177:      #(FullSpec
ca@2177:         name: windowSpec
ca@2177:         window: 
ca@2177:        (WindowSpec
ca@2177:           label: 'ViewTreeInspector'
ca@2177:           name: 'ViewTreeInspector'
ca@2177:           min: (Point 10 10)
ca@2177:           max: (Point 1024 9999)
ca@2451:           bounds: (Rectangle 0 0 381 654)
ca@2177:           menu: menu
ca@2177:         )
ca@2177:         component: 
ca@2177:        (SpecCollection
ca@2177:           collection: (
ca@2177:            (MenuPanelSpec
ca@2177:               name: 'toolbarMenu'
ca@2177:               layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)
ca@2177:               menu: toolbarMenu
ca@2177:               textDefault: true
ca@2177:             )
ca@2177:            (HierarchicalListViewSpec
ca@2177:               name: 'List'
ca@2458:               layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 0 1.0)
ca@2177:               level: 1
ca@2177:               model: model
ca@2177:               menu: middleButtonMenu
ca@2177:               hasHorizontalScrollBar: true
ca@2177:               hasVerticalScrollBar: true
ca@2177:               miniScrollerHorizontal: true
ca@2177:               miniScrollerVertical: false
ca@2177:               listModel: listOfItems
ca@2177:               multipleSelectOk: true
ca@2177:               useIndex: false
ca@2177:               highlightMode: label
ca@2177:               showLeftIndicators: false
ca@2177:               indicatorSelector: indicatorClicked:
ca@2177:               useDefaultIcons: false
ca@2177:               postBuildCallback: postBuildTree:
ca@2177:             )
ca@2177:            )
ca@2177:          
ca@2177:         )
ca@2177:       )
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication class methodsFor:'menu specs'!
ca@2177: 
ca@2177: menu
ca@2177:     "This resource specification was automatically generated
ca@2177:      by the MenuEditor of ST/X."
ca@2177: 
ca@2177:     "Do not manually edit this!! If it is corrupted,
ca@2177:      the MenuEditor may not be able to read the specification."
ca@2177: 
ca@2177:     "
ca@2454:      MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
ca@2454:      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
ca@2177:     "
ca@2177: 
ca@2177:     <resource: #menu>
ca@2177: 
ca@2177:     ^ 
ca@2177:      #(Menu
ca@2177:         (
ca@2177:          (MenuItem
ca@2177:             label: 'File'
ca@2177:             translateLabel: true
ca@2177:             submenu: 
ca@2177:            (Menu
ca@2177:               (
ca@2177:                (MenuItem
ca@2177:                   label: 'Pick a View'
ca@2177:                   itemValue: doPickViews
ca@2177:                   translateLabel: true
ca@2177:                 )
ca@2177:                (MenuItem
ca@2455:                   enabled: hasTargetWidgetChannel
ca@2177:                   label: 'Release Picked View'
ca@2177:                   itemValue: doUnpick
ca@2177:                   translateLabel: true
ca@2177:                 )
ca@2177:                (MenuItem
ca@2177:                   label: '-'
ca@2177:                 )
ca@2177:                (MenuItem
ca@2177:                   label: 'Exit'
ca@2177:                   itemValue: closeRequest
ca@2177:                   translateLabel: true
ca@2177:                 )
ca@2177:                )
ca@2177:               nil
ca@2177:               nil
ca@2177:             )
ca@2177:           )
ca@2177:          (MenuItem
ca@2454:             label: 'Settings'
ca@2454:             translateLabel: true
ca@2454:             submenu: 
ca@2454:            (Menu
ca@2454:               (
ca@2454:                (MenuItem
ca@2454:                   label: 'Test Mode'
ca@2454:                   translateLabel: true
ca@2454:                   hideMenuOnActivated: false
ca@2454:                   indication: testModeChannel
ca@2454:                 )
ca@2454:                (MenuItem
ca@2454:                   enabled: testModeChannel
ca@2454:                   label: 'Follow Focus'
ca@2454:                   translateLabel: true
ca@2454:                   hideMenuOnActivated: false
ca@2454:                   indication: followFocusChannel
ca@2454:                 )
ca@2454:                (MenuItem
ca@2454:                   label: '-'
ca@2454:                 )
ca@2454:                (MenuItem
ca@2454:                   label: 'Select on Click'
ca@2454:                   translateLabel: true
ca@2454:                   hideMenuOnActivated: false
ca@2454:                   indication: selectOnClickHolder
ca@2454:                 )
ca@2454:                (MenuItem
ca@2454:                   label: '-'
ca@2454:                 )
ca@2454:                (MenuItem
ca@2454:                   label: 'Show Name of Widgets'
ca@2454:                   translateLabel: true
ca@2454:                   hideMenuOnActivated: false
ca@2454:                   indication: showNamesHolder
ca@2454:                 )
ca@2454:                )
ca@2454:               nil
ca@2454:               nil
ca@2454:             )
ca@2454:           )
ca@2454:          (MenuItem
ca@2177:             label: ''
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             enabled: hasSingleSelectionHolder
ca@2177:             label: 'Menu'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: middleButtonMenu
ca@2177:           )
ca@2177:          (MenuItem
ca@2455:             enabled: hasTargetWidgetChannel
ca@2177:             label: 'Components'
ca@2177:             translateLabel: true
ca@2177:             startGroup: right
ca@2177:             submenuChannel: submenuComponents:
ca@2177:           )
ca@2177:          (MenuItem
ca@2455:             enabled: hasTargetWidgetChannel
ca@2177:             label: 'Applications'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuApplications:
ca@2177:           )
ca@2177:          )
ca@2177:         nil
ca@2177:         nil
ca@2177:       )
ca@2177: !
ca@2177: 
ca@2177: middleButtonMenu
ca@2177:     "This resource specification was automatically generated
ca@2177:      by the MenuEditor of ST/X."
ca@2177: 
ca@2177:     "Do not manually edit this!! If it is corrupted,
ca@2177:      the MenuEditor may not be able to read the specification."
ca@2177: 
ca@2177:     "
ca@2177:      MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
ca@2177:      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
ca@2177:     "
ca@2177: 
ca@2177:     <resource: #menu>
ca@2177: 
ca@2177:     ^ 
ca@2177:      #(Menu
ca@2177:         (
ca@2177:          (MenuItem
ca@2177:             label: 'Geometry'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuGeometry:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Interface'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuInterface:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Visibility'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuVisibility:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '-'
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Browse View Class'
ca@2177:             itemValue: doBrowse:
ca@2177:             translateLabel: true
ca@2177:             argument: view
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Browse Model Class'
ca@2177:             itemValue: doBrowse:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasModel
ca@2177:             argument: model
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Browse Application Class'
ca@2177:             itemValue: doBrowse:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasApplication
ca@2177:             argument: application
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Browse Controller Class'
ca@2177:             itemValue: doBrowse:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasController
ca@2177:             argument: controller
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '-'
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Inspect View'
ca@2177:             itemValue: doInspect:
ca@2177:             translateLabel: true
ca@2177:             argument: view
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Inspect Window Group'
ca@2177:             itemValue: doInspect:
ca@2177:             translateLabel: true
ca@2177:             argument: group
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Inspect Model'
ca@2177:             itemValue: doInspect:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasModel
ca@2177:             argument: model
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Inspect Application'
ca@2177:             itemValue: doInspect:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasApplication
ca@2177:             argument: application
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Inspect Controller'
ca@2177:             itemValue: doInspect:
ca@2177:             translateLabel: true
ca@2177:             isVisible: hasController
ca@2177:             argument: controller
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '-'
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Flash'
ca@2177:             itemValue: doFlash
ca@2177:             translateLabel: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '-'
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Destroy'
ca@2177:             itemValue: doDestroy
ca@2177:             translateLabel: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '-'
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: 'Instance Variables'
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuInspector:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: '='
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             label: ''
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             enabled: selectedComponentHasChildren
ca@2177:             label: 'Applications'
ca@2177:             nameKey: single
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuApplications:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          (MenuItem
ca@2177:             enabled: selectedComponentHasChildren
ca@2177:             label: 'Components'
ca@2177:             nameKey: single
ca@2177:             translateLabel: true
ca@2177:             submenuChannel: submenuComponents:
ca@2177:             keepLinkedMenu: true
ca@2177:           )
ca@2177:          )
ca@2177:         nil
ca@2177:         nil
ca@2177:       )
ca@2177: !
ca@2177: 
ca@2177: toolbarMenu
ca@2177:     "This resource specification was automatically generated
ca@2177:      by the MenuEditor of ST/X."
ca@2177: 
ca@2177:     "Do not manually edit this!! If it is corrupted,
ca@2177:      the MenuEditor may not be able to read the specification."
ca@2177: 
ca@2177:     "
ca@2451:      MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#toolbarMenu
ca@2451:      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication toolbarMenu)) startUp
ca@2177:     "
ca@2177: 
ca@2177:     <resource: #menu>
ca@2177: 
ca@2177:     ^ 
ca@2177:      #(Menu
ca@2177:         (
ca@2177:          (MenuItem
ca@2454:             enabled: hasSingleSelectionHolder
ca@2454:             label: 'Application'
ca@2454:             itemValue: doBrowse:
ca@2454:             translateLabel: false
ca@2454:             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454:             argument: application
ca@2454:           )
ca@2454:          (MenuItem
ca@2454:             enabled: hasSingleSelectionHolder
ca@2454:             label: 'Application'
ca@2454:             itemValue: doInspect:
ca@2454:             translateLabel: false
ca@2454:             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
ca@2454:             argument: application
ca@2177:           )
ca@2177:          (MenuItem
ca@2455:             label: ''
ca@2177:           )
ca@2177:          (MenuItem
ca@2454:             enabled: hasSingleSelectionHolder
ca@2454:             label: 'Widget'
ca@2454:             itemValue: doBrowse:
ca@2454:             translateLabel: false
ca@2454:             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454:             argument: view
ca@2177:           )
ca@2451:          (MenuItem
ca@2454:             enabled: hasSingleSelectionHolder
ca@2454:             label: 'Widget'
ca@2454:             itemValue: doInspect:
ca@2451:             translateLabel: true
ca@2454:             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Widget')
ca@2454:             argument: view
ca@2451:           )
ca@2177:          )
ca@2177:         nil
ca@2177:         nil
ca@2177:       )
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'actions'!
ca@2177: 
ca@2177: indicatorClicked:anIndex
ca@2177:     |item sensor|
ca@2177: 
ca@2177:     item := model listOfItems at:anIndex ifAbsent:nil.
ca@2177: 
ca@2177:     item notNil ifTrue:[
ca@2177:         (     (sensor := self window sensor) notNil
ca@2177:          and:[(sensor ctrlDown or:[sensor shiftDown])]
ca@2177:         ) ifTrue:[
ca@2177:             item recursiveToggleExpand
ca@2177:         ] ifFalse:[
ca@2177:             item toggleExpand
ca@2177:         ]
ca@2177:     ].
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'aspects'!
ca@2177: 
ca@2177: followFocusChannel
ca@2455:     "boolean holder, which indicates whether selection changed dependend on the focus view"
ca@2455: 
ca@2177:     ^ followFocusChannel
ca@2177: !
ca@2177: 
ca@2177: hasSingleSelectionHolder
ca@2455:     "boolean holder, true if one item is selected"
ca@2455: 
ca@2177:     ^ hasSingleSelectionHolder
ca@2177: !
ca@2177: 
ca@2455: hasTargetWidgetChannel
ca@2455:     "answer the channel which is set to true if a target widget exists"
ca@2455: 
ca@2455:     ^ model hasTargetWidgetChannel
ca@2455: !
ca@2455: 
ca@2177: listOfItems
ca@2455:     "returns the hierarchical list of items"
ca@2455: 
ca@2177:     ^ model listOfItems
ca@2177: !
ca@2177: 
ca@2177: model
ca@2455:     "returns my selection model, a ViewTreeModel"
ca@2455: 
ca@2177:     ^ model
ca@2177: !
ca@2177: 
ca@2177: selectOnClickHolder
ca@2455:     "boolean holder, which indicates whether the selection will change on click"
ca@2455: 
ca@2177:     ^ model selectOnClickHolder
ca@2177: !
ca@2177: 
ca@2451: showNamesHolder
ca@2451:     "boolean holder, which indicates whether application names or widget names
ca@2455:      as additional text are shown for the items"
ca@2455: 
ca@2451:     ^ showNamesHolder
ca@2451: !
ca@2451: 
ca@2177: testModeChannel
ca@2455:     "answer a boolean channel which describes the behaviour how to process
ca@2455:      events on the target view.
ca@2455: 
ca@2455:      false: all input events are eaten and the selection is shown on the target view.
ca@2455:      true:  no  input events are eaten and no  selection is shown on the target view."
ca@2455: 
ca@2455:     ^ model testModeChannel
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'change & update'!
ca@2177: 
ca@2177: selectionChanged
ca@2455:     "called if the selection changed"
ca@2455: 
ca@2177:     |info view item|
ca@2177: 
ca@2177:     item := model selectedItem.
ca@2177: 
ca@2177:     item notNil ifTrue:[ |state|
ca@2177:         view := item widget.
ca@2177: 
ca@2177:         view id isNil ifTrue:[
ca@2177:             state := 'no ID'.
ca@2177:         ] ifFalse:[
ca@2177:             view shown ifTrue:[
ca@2177:                 state := 'visible'.
ca@2177:             ] ifFalse:[
ca@2177:                 state := 'invisible'
ca@2177:             ].
ca@2177:         ].
ca@2177:         info := '%1 [%2] - %3' bindWith:(view class name)
ca@2177:                                    with:(view name ? '') with:state allBold.
ca@2177: 
ca@2177:     ] ifFalse:[
ca@2177:         info := ''
ca@2177:     ].
ca@2177:     hasSingleSelectionHolder value:(view notNil).
ca@2177: !
ca@2177: 
ca@2177: update:something with:someArgument from:aModel
ca@2454:     |oldSelection|
ca@2454: 
ca@2451:     aModel == showNamesHolder ifTrue:[
ca@2455:         oldSelection := model selectedItem.
ca@2454:         model selectedItem:nil.
ca@2451:         self listOfItems showWidgetNames:(aModel value).
ca@2454:         model selectedItem:oldSelection.
ca@2451:         ^ self
ca@2451:     ].
ca@2458: 
ca@2458:     aModel == model ifTrue:[
ca@2458:         self selectionChanged.
ca@2458:         ^ self
ca@2458:     ].
ca@2458: 
ca@2177:     super update:something with:someArgument from:aModel.
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'event processing'!
ca@2177: 
ca@2177: processButtonMotionEvent:ev
ca@2455:     "handle a button motion event"
ca@2455: 
ca@2455:     |click rootView|
ca@2455: 
ca@2455:     motionAction isNil ifTrue:[^ self].
ca@2177: 
ca@2455:     (rootView := model rootView) isNil ifTrue:[
ca@2455:         clickedItem := motionAction := nil.
ca@2455:         ^ self
ca@2455:     ].
ca@2177: 
ca@2455:     click := rootView device
ca@2455:             translatePoint:((ev x)@ (ev y))
ca@2455:             fromView:(ev view)
ca@2455:             toView:rootView.
ca@2455: 
ca@2455:     click = clickedPoint ifFalse:[
ca@2455:         (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
ca@2455:             motionAction value:click
ca@2177:         ]
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: processButtonPressEvent:ev
ca@2455:     "handle a buttopn press event"
ca@2177: 
ca@2455:     |rootView sensor lastRectangle|
ca@2455: 
ca@2455:     rootView    := model rootView.
ca@2177:     sensor      := model rootView sensor.
ca@2177:     clickedItem := model listOfItems detectItemRespondsToView:(ev view).
ca@2177: 
ca@2177:     (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
ca@2177:         clickedItem notNil ifTrue:[
ca@2177:             self selectOnClickHolder value ifTrue:[
ca@2177:                 model toggleSelectItem:clickedItem
ca@2177:             ].
ca@2177:         ].
ca@2177:         clickedItem := motionAction := nil.
ca@2455:         ^ self
ca@2455:     ].
ca@2177: 
ca@2455:     clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
ca@2455:     lastRectangle := nil.
ca@2177: 
ca@2455:     motionAction :=[:p|
ca@2455:         rootView    := model rootView device rootView.
ca@2455:         rootView    := model rootView.
ca@2455:         clickedItem := nil.
ca@2177: 
ca@2455:         rootView xoring:[
ca@2455:             lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
ca@2455:                                 ifFalse:[ rootView clippedByChildren:false ].
ca@2455: 
ca@2455:             p isNil ifTrue:[
ca@2455:                 rootView clippedByChildren:true.
ca@2455:                 motionAction := nil.
ca@2455:             ] ifFalse:[
ca@2455:                 lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
ca@2455:                 rootView displayRectangle:lastRectangle.
ca@2177:             ].
ca@2455:             rootView flush.
ca@2455:         ].
ca@2455:         lastRectangle
ca@2455:     ].
ca@2177: !
ca@2177: 
ca@2177: processButtonReleaseEvent:anEvent
ca@2455:     "handle a button release event"
ca@2455: 
ca@2177:     |rootView rectangle newItems widget origin|
ca@2177: 
ca@2455:     (rootView := model rootView) isNil ifTrue:[
ca@2455:         clickedItem := motionAction := nil.
ca@2455:         ^ self
ca@2455:     ].
ca@2177:     motionAction isNil ifTrue:[ ^ self ].
ca@2177:     clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
ca@2177: 
ca@2455:     rectangle := motionAction value:nil.
ca@2455:     rectangle isNil ifTrue:[^ self].
ca@2455: 
ca@2455:     newItems := OrderedCollection new.
ca@2177: 
ca@2455:     model rootItem recursiveDo:[:anItem|
ca@2455:         widget := anItem widget.
ca@2455:         origin := widget originRelativeTo:rootView.
ca@2177: 
ca@2455:         (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
ca@2455:             newItems add:anItem.
ca@2455:         ]
ca@2177:     ].
ca@2455:     model value:newItems.
ca@2177: !
ca@2177: 
ca@2177: processEvent:anEvent
ca@2455:     "process an event"
ca@2455: 
ca@2177:     |button menu|
ca@2177: 
ca@2177:     anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
ca@2177:     anEvent isButtonEvent  ifFalse:[ ^ self ].
ca@2177: 
ca@2177:     button := anEvent button.
ca@2177: 
ca@2177:     (button == 2 or:[button == #menu]) ifTrue:[
ca@2177:         motionAction isNil ifTrue:[
ca@2177:             anEvent isButtonPressEvent ifTrue:[
ca@2177:                 self selectOnClickHolder value ifTrue:[
ca@2177:                     menu := self middleButtonMenu value.
ca@2177:                     menu notNil ifTrue:[
ca@2177:                         menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
ca@2177:                                       receiver:self.
ca@2177:                         menu startUp.
ca@2177:                     ]
ca@2177:                 ].
ca@2177:             ].
ca@2177:             clickedItem := nil.
ca@2177:         ].
ca@2177:         ^ self
ca@2177:     ].
ca@2177: 
ca@2177:     anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].
ca@2177:     anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].
ca@2177: 
ca@2177:     anEvent isButtonReleaseEvent ifTrue:[
ca@2177:         self selectOnClickHolder value ifTrue:[
ca@2177:             self processButtonReleaseEvent:anEvent
ca@2177:         ].
ca@2177:     ].
ca@2177:     clickedItem := motionAction := nil.
ca@2177: 
ca@2177:     anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
ca@2177:         self selectOnClickHolder value ifTrue:[
ca@2177:             self doInspect:#view.
ca@2177:         ].
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: processKeyPressEvent:anEvent
ca@2455:     "process an key press event"
ca@2455: 
ca@2177:     |item prnt idx key max next|
ca@2177: 
ca@2177:     key := anEvent key.
ca@2177:     key isSymbol ifFalse:[^ self].
ca@2177: 
ca@2177:     key == #Delete    ifTrue:[ ^ self doDestroy ].
ca@2177:     key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
ca@2177: 
ca@2177:     (   key == #CursorUp
ca@2177:     or:[key == #CursorDown
ca@2177:     or:[key == #CursorLeft
ca@2177:     or:[key == #CursorRight]]]
ca@2177:     ) ifFalse:[
ca@2177:         ^ self
ca@2177:     ].
ca@2177:     item := model selectedItem.
ca@2177: 
ca@2177:     item isNil ifTrue:[
ca@2177:         ^ model selectedItem:(model first ? model rootItem)
ca@2177:     ].
ca@2177: 
ca@2177:     prnt := item parent.
ca@2177:     prnt isNil ifTrue:[
ca@2177:         "/ is the root item
ca@2177:         (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
ca@2177:                                                   ifFalse:[item := item at:1 ifAbsent:item].
ca@2177: 
ca@2177:       ^ model selectedItem:item
ca@2177:     ].
ca@2177:     key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
ca@2177: 
ca@2177:     key == #CursorRight ifTrue:[
ca@2177:         next := item at:1 ifAbsent:nil.
ca@2177:         next notNil ifTrue:[ model selectedItem:next ].
ca@2177:       ^ self
ca@2177:     ].
ca@2177: 
ca@2177:     max := prnt size.
ca@2177: 
ca@2177:     key == #CursorUp ifTrue:[
ca@2177:         idx := prnt identityIndexOf:item.
ca@2177:         idx == 1 ifTrue:[idx := max + 1].
ca@2177:         model selectedItem:(prnt at:idx - 1).
ca@2177:       ^ self.
ca@2177:     ].
ca@2177: 
ca@2177:     key == #CursorDown ifTrue:[
ca@2177:         idx := prnt identityIndexOf:item.
ca@2177:         idx == max ifTrue:[idx := 0].
ca@2177:         model selectedItem:(prnt at:idx + 1).
ca@2177:       ^ self.
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: processMappedView:aView
ca@2455:     "process a mapped event"
ca@2455: 
ca@2177:     |parent anchor|
ca@2177: 
ca@2177:     parent := self listOfItems detectItemRespondsToView:aView.
ca@2177:     parent isNil ifTrue:[ ^ self ].
ca@2177: 
ca@2177:     NotFoundSignal handle:[:ex|
ca@2177:         "contained subvies used by spec are not yet created;
ca@2177:          thus we have to wait until last used subview is build
ca@2177:         "
ca@2177:         anchor := nil.
ca@2177:     ] do:[
ca@2177:         anchor := parent class buildViewsFrom:(parent widget).
ca@2177:     ].
ca@2177:     anchor notNil ifTrue:[
ca@2177:         parent updateFromChildren:anchor children.
ca@2177:     ].
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'initialization & release'!
ca@2177: 
ca@2177: closeDownViews
ca@2455:     "release the grapped application"
ca@2455: 
ca@2177:     process := nil.
ca@2177:     super closeDownViews.
ca@2177:     self doUnpick.
ca@2177: !
ca@2177: 
ca@2177: initialize
ca@2455:     "setup my model and channels"
ca@2455: 
ca@2177:     super initialize.
ca@2177: 
ca@2177:     hasSingleSelectionHolder := false asValue.
ca@2177:     followFocusChannel       := false asValue.
ca@2177: 
ca@2177:     model := ViewTreeModel new.
ca@2177:     model inputEventAction:[:ev| self processEvent:ev ].
ca@2177:     model mappedViewAction:[:vw| self processMappedView:vw ].
ca@2177:     model application:self.
ca@2458:     model addDependent:self.
ca@2458: 
ca@2177: 
ca@2451:     showNamesHolder := false asValue.
ca@2451:     showNamesHolder addDependent:self.
ca@2177: !
ca@2177: 
ca@2177: postBuildTree:aTree
ca@2177:     treeView := aTree scrolledView.
ca@2177:     treeView hasConstantHeight:true.
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'menu queries'!
ca@2177: 
ca@2177: hasApplication
ca@2455:     "returns true if the current selected view has an application"
ca@2455: 
ca@2177:     |view|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:   ^ (view notNil and:[view application notNil])
ca@2177: !
ca@2177: 
ca@2177: hasController
ca@2177:     "returns true if the current selected item's view has a controller
ca@2455:      other than nil or the view itself"
ca@2455: 
ca@2177:     |view controller|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177: 
ca@2177:     view notNil ifTrue:[
ca@2177:         controller := view controller.
ca@2177:       ^ (controller notNil and:[controller ~~ view])
ca@2177:     ].
ca@2177:     ^ false
ca@2177: !
ca@2177: 
ca@2177: hasModel
ca@2455:     "returns true if the current selected view has a model"
ca@2455: 
ca@2177:     |view|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:   ^ (view notNil and:[view model notNil])
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'menu specs'!
ca@2177: 
ca@2177: middleButtonMenu
ca@2455:     "returns the middleButton menu for the single selected item or nil"
ca@2455: 
ca@2177:     ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
ca@2177:                                  ifFalse:[nil]
ca@2177:       ]
ca@2177: !
ca@2177: 
ca@2177: submenuApplications:aMenu
ca@2177:     |applications menu item list addBlock|
ca@2177: 
ca@2177:     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177:                                               ifFalse:[model rootItem].
ca@2177:     item isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     applications := IdentityDictionary new.
ca@2177: 
ca@2177:     addBlock := [:el| |cls ctr|
ca@2177:         cls := self resolveApplicationClassFor:el.
ca@2177: 
ca@2177:         cls notNil ifTrue:[
ca@2177:             ctr := applications at:cls ifAbsent:0.
ca@2177:             applications at:cls put:(ctr + 1).
ca@2177:         ].
ca@2177:     ].
ca@2177:     item recursiveDo:addBlock.
ca@2177:     addBlock value:item.
ca@2177: 
ca@2177:     applications isEmpty ifTrue:[^ nil ].
ca@2177:     list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177: 
ca@2177:     applications keysAndValuesDo:[:cls :ctr|
ca@2177:        list add:(MenuDesc title:(cls name)
ca@2177:                           value:(ctr printString)
ca@2177:                          action:[self doSelectNextOfApplicationClass:cls startingIn:item]
ca@2177:                  ).
ca@2177:     ].
ca@2177: 
ca@2177:     menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177:     menu do:[:el|
ca@2177:         el hideMenuOnActivated:false
ca@2177:     ].
ca@2177:     ^ menu
ca@2177: !
ca@2177: 
ca@2177: submenuComponents:aMenu
ca@2177:     |widgets list total menu item|
ca@2177: 
ca@2177:     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177:                                               ifFalse:[model rootItem].
ca@2177:     item isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     widgets := IdentityDictionary new.
ca@2177:     total   := 0.
ca@2177: 
ca@2177:     item recursiveDo:[:el| |cls ctr|
ca@2177:         cls := el widget.
ca@2177: 
ca@2177:         cls notNil ifTrue:[
ca@2177:             cls := cls class.
ca@2177:             ctr := widgets at:cls ifAbsent:0.
ca@2177:             widgets at:cls put:(ctr + 1).
ca@2177:             total := total + 1.
ca@2177:         ].
ca@2177:     ].
ca@2177:     total == 0 ifTrue:[^ nil].
ca@2177:     list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177: 
ca@2177:     widgets keysAndValuesDo:[:cls :ctr|
ca@2177:         list add:(MenuDesc title:(cls name)
ca@2177:                            value:(ctr printString)
ca@2177:                           action:[self doSelectNextOfClass:cls startingIn:item]
ca@2177:                  ).
ca@2177:     ].
ca@2177:     list := list asOrderedCollection.
ca@2177:     list add:(MenuDesc separator).
ca@2177:     list add:(MenuDesc title:'Total' value:(total printString)).
ca@2177:     menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177:     menu do:[:el|
ca@2177:         el hideMenuOnActivated:false
ca@2177:     ].
ca@2177:     ^ menu
ca@2177: !
ca@2177: 
ca@2177: submenuGeometry:aMenu
ca@2455:     "builds and returns the geometry submenu"
ca@2455: 
ca@2177:     |view point inst list x y|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     list := OrderedCollection new.
ca@2177: 
ca@2177:     "/ origin
ca@2177:     point := view relativeOrigin.
ca@2177:     point isNil ifTrue:[ point := view origin ].
ca@2177: 
ca@2177:     x := view left.
ca@2177:     y := view top.
ca@2177: 
ca@2177:     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177:                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177: 
ca@2177:     list add:(MenuDesc title:'origin' value:inst).
ca@2177: 
ca@2177:     "/ corner
ca@2177:     point := view relativeCorner.
ca@2177:     point isNil ifTrue:[ point := view corner ].
ca@2177: 
ca@2177:     x := view right.
ca@2177:     y := view bottom.
ca@2177: 
ca@2177:     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177:                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177: 
ca@2177:     list add:(MenuDesc title:'corner' value:inst).
ca@2177: 
ca@2177:     "/ extent
ca@2177:     (point := view relativeExtent) isNil ifTrue:[point := view extent].
ca@2177:     list add:(MenuDesc title:'extent' value:point).
ca@2177: 
ca@2177:     "/ preferred extent
ca@2177:     list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
ca@2177:     list add:(MenuDesc separator).
ca@2177: 
ca@2177:     "/ view insets
ca@2177:     inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
ca@2177:                                          with:(view rightInset)
ca@2177:                                          with:(view topInset)
ca@2177:                                          with:(view bottomInset).
ca@2177: 
ca@2177:     list add:(MenuDesc title:'insets'      value:inst).
ca@2177:     list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
ca@2177:     list add:(MenuDesc title:'level'       value:(view level)).
ca@2177:     list add:(MenuDesc separator).
ca@2177: 
ca@2177:     (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
ca@2177:     list add:(MenuDesc title:'layout' value:inst).
ca@2177: 
ca@2177:     (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
ca@2177:     list add:(MenuDesc title:'transformation' value:inst).
ca@2177: 
ca@2177:   ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177: !
ca@2177: 
ca@2177: submenuInspector:aMenu
ca@2455:     "builds and returns the inspector submenu"
ca@2455: 
ca@2177:     |view list n names label value|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     n := view class instSize.
ca@2177:     n > 0 ifFalse:[^ nil ].
ca@2177: 
ca@2177:     list  := OrderedCollection new:n.
ca@2177:     names := view class allInstVarNames.
ca@2177: 
ca@2177:     1 to:n do:[:i| |action|
ca@2177:         label := (names at:i) printString.
ca@2177:         value := view instVarAt:i.
ca@2177:         value isNil ifTrue:[
ca@2177:             value  := '------'.
ca@2177:             action := nil.
ca@2177:         ] ifFalse:[
ca@2177:             value  := value displayString contractAtEndTo:40.
ca@2177:             action := [(view instVarAt:i) inspect].
ca@2177:         ].
ca@2177:         list add:(MenuDesc title:label value:value action:action).
ca@2177:     ].
ca@2177: 
ca@2177:     ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177: !
ca@2177: 
ca@2177: submenuInterface:aMenu
ca@2455:     "builds and returns the interface submenu"
ca@2455: 
ca@2177:     |view label inst value list|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     list := OrderedCollection new.
ca@2177: 
ca@2177:     inst  := view controller.
ca@2177:     value := nil.
ca@2177: 
ca@2177:     inst isNil ifTrue:[
ca@2177:         label := nil
ca@2177:     ] ifFalse:[
ca@2177:         inst == view ifTrue:[ label := '== view itself' ]
ca@2177:                     ifFalse:[ label := inst displayString.
ca@2177:                               value := [view controller inspect].
ca@2177:                             ].
ca@2177:     ].
ca@2177:     list add:(MenuDesc title:'controller' value:label action:value).
ca@2177: 
ca@2177:     inst := view delegate.
ca@2177:     inst notNil ifTrue:[
ca@2177:         list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
ca@2177:     ].
ca@2177: 
ca@2177:     inst := view application.
ca@2177: 
ca@2177:     inst notNil ifTrue:[ |topAppl|
ca@2177:         list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
ca@2177: 
ca@2177:         topAppl := inst topApplication.
ca@2177: 
ca@2177:         (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
ca@2177:             list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
ca@2177:         ].
ca@2177:     ].
ca@2177:     list add:(MenuDesc separator).
ca@2177: 
ca@2177:     (view respondsTo:#'model:') ifTrue:[
ca@2177:         inst := model.
ca@2177: 
ca@2177:         inst isNil ifTrue:[ label := value := nil ]
ca@2177:                   ifFalse:[ label := inst displayString.
ca@2177:                             value := [ view model inspect ].
ca@2177:                           ].
ca@2177: 
ca@2177:         list add:(MenuDesc title:'model' value:label action:value).
ca@2177: 
ca@2177:         (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
ca@2177:             view modelInterface keysAndValuesDo:[:key : val|
ca@2177:                 val isNil ifTrue:[ label := nil ]
ca@2177:                          ifFalse:[ label := val displayString ].
ca@2177: 
ca@2177:                 list add:(MenuDesc title:('      - ', key) value:label ).
ca@2177:             ]
ca@2177:         ].
ca@2177:     ].
ca@2177: 
ca@2177:     (view respondsTo:#enableChannel) ifTrue:[
ca@2177:         inst := view enableChannel.
ca@2177: 
ca@2177:         inst isNil ifTrue:[ label := value := nil ]
ca@2177:                   ifFalse:[ label := inst displayString.
ca@2177:                             value := [ view enableChannel inspect ].
ca@2177:                           ].
ca@2177: 
ca@2177:         list add:(MenuDesc title:'enableChannel' value:label action:value).
ca@2177:     ].
ca@2177: 
ca@2177:     list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
ca@2177: 
ca@2177:     (view respondsTo:#listHolder) ifTrue:[
ca@2177:         inst := view listHolder.
ca@2177: 
ca@2177:         inst isNil ifTrue:[ label := value := nil ]
ca@2177:                   ifFalse:[ label := inst class printString.
ca@2177:                             value := [ view listHolder inspect ].
ca@2177:                           ].
ca@2177:         list add:(MenuDesc title:'listHolder' value:label action:value).
ca@2177:     ].
ca@2177: 
ca@2177:     (view respondsTo:#list) ifTrue:[
ca@2177:         inst := view list.
ca@2177: 
ca@2177:         inst isNil ifTrue:[ label := value := nil ]
ca@2177:                   ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
ca@2177:                             value := [ view list inspect ].
ca@2177:                           ].
ca@2177: 
ca@2177:         list add:(MenuDesc title:'list' value:label action:value).
ca@2177:     ].
ca@2177: 
ca@2177:     list last isSeparator ifTrue:[ list removeLast ].
ca@2177:   ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177: !
ca@2177: 
ca@2177: submenuVisibility:aMenu
ca@2455:     "builds and returns the geometry submenu"
ca@2455: 
ca@2177:     |view list value|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[^ nil].
ca@2177: 
ca@2177:     list := OrderedCollection new.
ca@2177: 
ca@2177:     list add:(MenuDesc title:'device'     value:(view device printString)).
ca@2177:     list add:(MenuDesc title:'drawableId' value:(view id)).
ca@2177:     list add:(MenuDesc title:'gcId'       value:(view gcId)).
ca@2177: 
ca@2177:     list add:(MenuDesc separator).
ca@2177: 
ca@2177:     list add:(MenuDesc title:'shown'    value:(view shown)).
ca@2177:     list add:(MenuDesc title:'realized' value:(view realized)).
ca@2177: 
ca@2177:     list add:(MenuDesc separator).
ca@2177: 
ca@2177:     list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
ca@2177: 
ca@2177:     (value := view visibilityChannel) isNil ifTrue:[
ca@2177:         list add:(MenuDesc title:'visibilityChannel' value:'------').
ca@2177:     ] ifFalse:[
ca@2177:         list add:(MenuDesc title:'visibilityChannel'
ca@2177:                            value:(value displayString)
ca@2177:                           action:[view visibilityChannel inspect]).
ca@2177:     ].
ca@2177: 
ca@2177:         
ca@2177:   ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'private'!
ca@2177: 
ca@2177: selectFocusView
ca@2177:     |rootView focusItem focusView|
ca@2177: 
ca@2177:     rootView := model rootView.
ca@2177: 
ca@2177:     (rootView notNil and:[rootView shown]) ifTrue:[
ca@2177:         focusView := rootView windowGroup focusView.
ca@2177:     ].
ca@2177:     focusView isNil ifTrue:[^ self ].
ca@2177: 
ca@2177:     focusItem := model selectedItem.
ca@2177: 
ca@2177:     (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
ca@2177:         ^ self
ca@2177:     ].
ca@2177:     focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
ca@2177: 
ca@2177:     focusItem notNil ifTrue:[
ca@2177:         model selectItem:focusItem.
ca@2177:     ].        
ca@2177: !
ca@2177: 
ca@2177: setRootItem:aRootItemOrNil
ca@2177:     |theProcess|
ca@2177: 
ca@2177:     aRootItemOrNil isNil ifTrue:[
ca@2177:         process := nil.
ca@2177:     ] ifFalse:[
ca@2177:         "/ expand tree to level 3
ca@2177:         aRootItemOrNil do:[:aRootChild|
ca@2177:             aRootChild do:[:aSubChild| aSubChild expand ].
ca@2177:             aRootChild expand.
ca@2177:         ].
ca@2177:         aRootItemOrNil expand.
ca@2177: 
ca@2177:         process isNil ifTrue:[
ca@2177:             theProcess := process :=
ca@2455:                 Process for:[   |update testModeChannel|
ca@2177: 
ca@2177:                                 update := false.
ca@2455:                                 testModeChannel := model testModeChannel.
ca@2177: 
ca@2455:                                 [process == theProcess] whileTrue:[
ca@2177:                                     Delay waitForSeconds:0.5.
ca@2177: 
ca@2177:                                     (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
ca@2455:                                         (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
ca@2177:                                             self selectFocusView.
ca@2177:                                         ].
ca@2177:                                         update ifTrue:[
ca@2177:                                             self updateShownStatus.
ca@2177:                                         ].
ca@2177:                                         update := update not.
ca@2177:                                     ].
ca@2177:                                 ].
ca@2177: 
ca@2177:                              ] priority:8.
ca@2177:             theProcess name:'ViewTreeApplication::Follow Focus'.
ca@2177:             theProcess resume.
ca@2177:         ].
ca@2177:     ].
ca@2177:     model rootItem:aRootItemOrNil.
ca@2177: !
ca@2177: 
ca@2177: updateShownStatus
ca@2177:     |rootItem min max visState listIdx visY0 visY1 height damage|
ca@2177: 
ca@2177:     rootItem := model rootItem.
ca@2177:     (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
ca@2177: 
ca@2177:     max := 0.
ca@2177:     min := 9999999.
ca@2177: 
ca@2177:     rootItem recursiveEachVisibleItemDo:[:anItem|
ca@2177:         visState := (anItem widget shown).
ca@2177: 
ca@2177:         visState ~~ anItem isDrawnShown ifTrue:[
ca@2177:             anItem isDrawnShown:visState.
ca@2177:             listIdx := treeView identityIndexOf:anItem.
ca@2177: 
ca@2177:             listIdx > 0 ifTrue:[    
ca@2177:                 max := max max:listIdx.
ca@2177:                 min := min min:listIdx.
ca@2177:             ].
ca@2177:         ].
ca@2177:     ].
ca@2177:     max < min ifTrue:[^ self].
ca@2177:     max := max + 1.
ca@2177: 
ca@2177:     visY0  := (treeView yVisibleOfLine:min) max:0.
ca@2177:     visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
ca@2177:     height := visY1 - visY0.
ca@2177:     
ca@2177:     height > 2 ifTrue:[
ca@2177:         treeView shown ifTrue:[
ca@2177:             damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
ca@2177:             treeView invalidateDeviceRectangle:damage repairNow:false.
ca@2177:         ].
ca@2177:     ].
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'selection'!
ca@2177: 
ca@2177: selectedView
ca@2455:     "answer the selected view or nil"
ca@2455: 
ca@2177:     |item|
ca@2177: 
ca@2177:     item := model selectedItem.
ca@2177:     item notNil ifTrue:[ ^ item widget ].
ca@2177:   ^ nil
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'testing'!
ca@2177: 
ca@2177: resolveApplicationClassFor:aTreeItem
ca@2177:     aTreeItem isApplicationClass ifTrue:[
ca@2177:        ^ aTreeItem applicationClass
ca@2177:     ].
ca@2177:     ^ nil
ca@2177: !
ca@2177: 
ca@2177: selectedComponentHasChildren
ca@2177:     |item|
ca@2177: 
ca@2177:     item := model selectedItem.
ca@2177:     ^ (item notNil and:[item hasChildren])
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication methodsFor:'user operations'!
ca@2177: 
ca@2177: doBrowse:what
ca@2177:     "open browser on:
ca@2177:         #view           browse class
ca@2177:         #model          browse model class
ca@2177:         #application    browse application class
ca@2177:         #controller     browse controller class
ca@2177:     "
ca@2177:     |view inst|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[^ self].
ca@2177: 
ca@2177:              what == #view        ifTrue:[ inst := view ]
ca@2177:     ifFalse:[what == #model       ifTrue:[ inst := view model ]
ca@2177:     ifFalse:[what == #application ifTrue:[ inst := view application ]
ca@2177:     ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
ca@2177:     ifFalse:[
ca@2177:         ^ self
ca@2177:     ]]]].
ca@2177: 
ca@2177:     inst notNil ifTrue:[
ca@2177:         inst class browserClass openInClass:(inst class) selector:nil
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: doDestroy
ca@2455:     "destroy the current selected view"
ca@2455: 
ca@2177:     |item parent|
ca@2177: 
ca@2177:     item := model selectedItem.
ca@2177:     item isNil ifTrue:[ ^ self].
ca@2177: 
ca@2177:     parent := item parent.
ca@2177: 
ca@2177:     parent isNil ifTrue:[
ca@2177:         "/ the root
ca@2177:         model withSelectionHiddenDo:[item deleteAll].
ca@2177:       ^ self
ca@2177:     ].
ca@2177: 
ca@2177:     model withSelectionHiddenDo:[
ca@2177:         |idx nsel|
ca@2177: 
ca@2177:         idx := parent identityIndexOf:item.
ca@2177: 
ca@2177:         idx == parent size ifTrue:[
ca@2177:             nsel := parent at:(idx - 1) ifAbsent:parent
ca@2177:         ] ifFalse:[
ca@2177:             nsel := parent at:(idx + 1)
ca@2177:         ].
ca@2177:         model setValue:nil.
ca@2177:         item delete.
ca@2177: 
ca@2177:         parent isLayoutContainer ifTrue:[
ca@2177:             parent widget sizeChanged:nil
ca@2177:         ].
ca@2177:         model value:nsel.
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: doFlash
ca@2455:     "flash the selected view"
ca@2455: 
ca@2177:     |view|
ca@2177: 
ca@2177:     view := self selectedView.
ca@2177:     view isNil ifTrue:[ ^ self].
ca@2177: 
ca@2177:     view shown ifTrue:[
ca@2177:         model withSelectionHiddenDo:[
ca@2177:             view perform:#flash ifNotUnderstood:nil.
ca@2177:         ].
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: doInspect:what
ca@2177:     "open inspector on:
ca@2177:         #view           inspect class
ca@2177:         #group          inspect windowGroup
ca@2177:         #model          inspect model
ca@2177:         #application    inspect application
ca@2177:         #controller     inspect controller
ca@2177:     "
ca@2177:     |inst|
ca@2177: 
ca@2177:     inst := self selectedView.
ca@2177:     inst isNil ifTrue:[^ self].
ca@2177: 
ca@2177:              what == #group       ifTrue:[ inst := inst windowGroup ]
ca@2177:     ifFalse:[what == #model       ifTrue:[ inst := inst model ]
ca@2177:     ifFalse:[what == #application ifTrue:[ inst := inst application ]
ca@2177:     ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
ca@2177: 
ca@2177:     inst notNil ifTrue:[ inst inspect ].
ca@2177: !
ca@2177: 
ca@2177: doPickViews
ca@2455:     "pick a window's topView"
ca@2455: 
ca@2177:     |window|
ca@2177: 
ca@2177:     self doUnpick.
ca@2177: 
ca@2177:     window := Screen current viewFromUser.
ca@2177:     window isNil ifTrue:[^ self].
ca@2177: 
ca@2177:     window := window topView.
ca@2177: 
ca@2177:     (    window == Screen current rootView
ca@2177:      or:[window == self window topView]
ca@2177:     ) ifTrue:[
ca@2177:         ^ self
ca@2177:     ].
ca@2177:     self setRootItem:(ViewTreeItem buildViewsFrom:window).
ca@2177: !
ca@2177: 
ca@2177: doSelectNextOfApplicationClass:aClass startingIn:anItem
ca@2177:     |startItem firstFound searchNext|
ca@2177: 
ca@2177:     startItem  := model last.
ca@2177:     searchNext := startItem notNil.        
ca@2177:     firstFound := nil.
ca@2177: 
ca@2177:     anItem recursiveDo:[:el|
ca@2177:         el == startItem ifTrue:[
ca@2177:             searchNext := false
ca@2177:         ] ifFalse:[
ca@2177:             (self resolveApplicationClassFor:el) == aClass ifTrue:[
ca@2177:                 searchNext ifFalse:[^ model selectItem:el].
ca@2177: 
ca@2177:                 firstFound isNil ifTrue:[
ca@2177:                     firstFound := el
ca@2177:                 ]
ca@2177:             ]
ca@2177:         ]
ca@2177:     ].
ca@2177:     firstFound notNil ifTrue:[
ca@2177:         self window beep.
ca@2177:         model selectItem:firstFound
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: doSelectNextOfClass:aClass startingIn:anItem
ca@2177:     |startItem firstFound searchNext|
ca@2177: 
ca@2177:     startItem  := model last.
ca@2177:     searchNext := startItem notNil.        
ca@2177:     firstFound := nil.
ca@2177: 
ca@2177:     anItem recursiveDo:[:el|
ca@2177:         el == startItem ifTrue:[
ca@2177:             searchNext := false
ca@2177:         ] ifFalse:[
ca@2177:             el widget class == aClass ifTrue:[
ca@2177:                 searchNext ifFalse:[^ model selectItem:el].
ca@2177: 
ca@2177:                 firstFound isNil ifTrue:[
ca@2177:                     firstFound := el
ca@2177:                 ]
ca@2177:             ]
ca@2177:         ]
ca@2177:     ].
ca@2177:     firstFound notNil ifTrue:[
ca@2177:         self window beep.
ca@2177:         model selectItem:firstFound
ca@2177:     ].
ca@2177: !
ca@2177: 
ca@2177: doUnpick
ca@2455:     "release current picked window and contained subwindows"
ca@2455: 
ca@2177:     self setRootItem:nil.
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc class methodsFor:'building'!
ca@2177: 
ca@2177: buildFromList:aList onGC:aMenu
ca@2177:     |tabSpec menu w menuPanel|
ca@2177: 
ca@2177:     w := 0.
ca@2177:     aList do:[:el| w := w max:(el widthOn:aMenu) ].
ca@2177: 
ca@2177:     tabSpec := TabulatorSpecification new.
ca@2177:     tabSpec unit:#pixel.
ca@2177:     tabSpec positions:#(0     1.5 ).
ca@2177:     tabSpec align:#(#left #left).
ca@2177: 
ca@2177:     w := w + 15.
ca@2177:     tabSpec positions:(Array with:0 with:w).
ca@2177: 
ca@2177:     menu := Menu new.
ca@2177: 
ca@2177:     aList do:[:el|
ca@2177:         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
ca@2177:     ].
ca@2177:     menuPanel := MenuPanel menu:menu.
ca@2177:     ^ menuPanel
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!
ca@2177: 
ca@2177: separator
ca@2177:     ^ self new
ca@2177: !
ca@2177: 
ca@2177: title:aTitle value:aValue
ca@2177:     ^ self title:aTitle value:aValue action:nil
ca@2177: !
ca@2177: 
ca@2177: title:aTitle value:aValue action:anAction
ca@2177:     ^ self new title:aTitle value:aValue action:anAction
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc methodsFor:'accessing'!
ca@2177: 
ca@2177: title
ca@2177:     ^ title
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc methodsFor:'building'!
ca@2177: 
ca@2177: asMenuItemWithTabulatorSpecification:aTabSpec
ca@2177:     |array|
ca@2177: 
ca@2177:     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
ca@2177: 
ca@2177:     array := Array with:(title, ':') with:'------'.
ca@2177: 
ca@2177:     value notNil ifTrue:[
ca@2177:         array at:2 put:(value printString, ' ')
ca@2177:     ].
ca@2177: 
ca@2177:   ^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
ca@2177:              value:action
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc methodsFor:'instance creation'!
ca@2177: 
ca@2177: title:aTitle value:aValue action:anAction
ca@2177:     "test for separator
ca@2177:     "
ca@2177:     title  := aTitle withoutSeparators.
ca@2177:     action := anAction.
ca@2177: 
ca@2177:     aValue notNil ifTrue:[
ca@2177:         value := aValue printString.
ca@2177: 
ca@2177:         value size > 70 ifTrue:[
ca@2177:             value := value copyFrom:1 to:70.
ca@2177:             value := value, '...'
ca@2177:         ]
ca@2177:     ].
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication::MenuDesc methodsFor:'queries'!
ca@2177: 
ca@2177: isSeparator
ca@2177:     ^ title isNil
ca@2177: !
ca@2177: 
ca@2177: widthOn:aGC
ca@2177:     title isNil ifTrue:[^ 5].  "/ separator
ca@2177:   ^ title widthOn:aGC
ca@2177: ! !
ca@2177: 
ca@2177: !ViewTreeApplication class methodsFor:'documentation'!
ca@2177: 
ca@2177: version
ca@2177:     ^ '$Header$'
ca@2177: ! !
ca@2177: 
ca@2177: ViewTreeApplication initialize!