Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 10 Feb 2010 23:10:55 +0100
changeset 2762 0c66aa3bfdff
parent 2759 d9a8fc3f0dc7
child 2770 9322aee00ea0
permissions -rw-r--r--
added: #doPickView #selectView: changed: #menu #openInPickMode #selectFocusView #toolbarMenu when clicking, select the clicked view; always show a view's name.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2748
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     1
"
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     2
 COPYRIGHT (c) 2007 by eXept Software AG
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     3
              All Rights Reserved
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     4
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     5
 This software is furnished under a license and may be used
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     6
 only in accordance with the terms of that license and with the
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     8
 be provided or otherwise made available to, or used by, any
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
     9
 other person.  No title to or ownership of the software is
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    10
 hereby transferred.
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    11
"
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    12
"{ Package: 'stx:libtool2' }"
87bb1815460b initial checkin
ca
parents:
diff changeset
    13
87bb1815460b initial checkin
ca
parents:
diff changeset
    14
"{ NameSpace: Tools }"
87bb1815460b initial checkin
ca
parents:
diff changeset
    15
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    16
ToolApplicationModel subclass:#ViewTreeInspectorApplication
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    17
	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
2458
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
    18
		motionAction process followFocusChannel showNamesHolder'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    19
	classVariableNames:''
87bb1815460b initial checkin
ca
parents:
diff changeset
    20
	poolDictionaries:''
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    21
	category:'Interface-Smalltalk'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    22
!
87bb1815460b initial checkin
ca
parents:
diff changeset
    23
87bb1815460b initial checkin
ca
parents:
diff changeset
    24
Object subclass:#MenuDesc
87bb1815460b initial checkin
ca
parents:
diff changeset
    25
	instanceVariableNames:'title value action'
87bb1815460b initial checkin
ca
parents:
diff changeset
    26
	classVariableNames:''
87bb1815460b initial checkin
ca
parents:
diff changeset
    27
	poolDictionaries:''
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    28
	privateIn:ViewTreeInspectorApplication
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    29
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    30
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    31
HierarchicalItem subclass:#ViewTreeItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    32
	instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    33
	classVariableNames:'HandleExtent'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    34
	poolDictionaries:''
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    35
	privateIn:ViewTreeInspectorApplication
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    36
!
87bb1815460b initial checkin
ca
parents:
diff changeset
    37
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    38
ValueModel subclass:#ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    39
	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    40
		inputEventAction mappedViewAction beforeSelectionChangedAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    41
		icons timedUpdateTask selectOnClickHolder testModeChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    42
		hasTargetWidgetChannel'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    43
	classVariableNames:''
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    44
	poolDictionaries:''
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    45
	privateIn:ViewTreeInspectorApplication
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    46
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    47
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    48
HierarchicalList subclass:#ItemList
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    49
	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    50
	classVariableNames:''
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    51
	poolDictionaries:''
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    52
	privateIn:ViewTreeInspectorApplication::ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    53
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    54
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    55
!ViewTreeInspectorApplication class methodsFor:'documentation'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    56
2748
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    57
copyright
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    58
"
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    59
 COPYRIGHT (c) 2007 by eXept Software AG
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    60
              All Rights Reserved
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    61
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    62
 This software is furnished under a license and may be used
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    63
 only in accordance with the terms of that license and with the
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    64
 inclusion of the above copyright notice.   This software may not
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    65
 be provided or otherwise made available to, or used by, any
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    66
 other person.  No title to or ownership of the software is
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    67
 hereby transferred.
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    68
"
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    69
!
76f6fd319918 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2747
diff changeset
    70
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    71
documentation
87bb1815460b initial checkin
ca
parents:
diff changeset
    72
"
87bb1815460b initial checkin
ca
parents:
diff changeset
    73
     Small application showing a ViewTreeModel use.
87bb1815460b initial checkin
ca
parents:
diff changeset
    74
87bb1815460b initial checkin
ca
parents:
diff changeset
    75
     It displays a hierarchical list of a selected TopView and
87bb1815460b initial checkin
ca
parents:
diff changeset
    76
     all its contained subViews.
87bb1815460b initial checkin
ca
parents:
diff changeset
    77
     Useful to have a look at subcomponents - to see how views
87bb1815460b initial checkin
ca
parents:
diff changeset
    78
     are structured.
87bb1815460b initial checkin
ca
parents:
diff changeset
    79
87bb1815460b initial checkin
ca
parents:
diff changeset
    80
87bb1815460b initial checkin
ca
parents:
diff changeset
    81
    [Instance variables:]
87bb1815460b initial checkin
ca
parents:
diff changeset
    82
        model           <ViewTreeModel>      the used ViewTreeModel
87bb1815460b initial checkin
ca
parents:
diff changeset
    83
        clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
87bb1815460b initial checkin
ca
parents:
diff changeset
    84
        clickedPoint    <Point>              point where the motion action started from.
87bb1815460b initial checkin
ca
parents:
diff changeset
    85
        motionAction    <Action>             (oneArg-) action called durring buttonMotion.
87bb1815460b initial checkin
ca
parents:
diff changeset
    86
87bb1815460b initial checkin
ca
parents:
diff changeset
    87
87bb1815460b initial checkin
ca
parents:
diff changeset
    88
    [author:]
87bb1815460b initial checkin
ca
parents:
diff changeset
    89
        Claus Atzkern
87bb1815460b initial checkin
ca
parents:
diff changeset
    90
87bb1815460b initial checkin
ca
parents:
diff changeset
    91
    [see also:]
87bb1815460b initial checkin
ca
parents:
diff changeset
    92
        ViewTreeModel
87bb1815460b initial checkin
ca
parents:
diff changeset
    93
        ViewTreeItem
87bb1815460b initial checkin
ca
parents:
diff changeset
    94
"
87bb1815460b initial checkin
ca
parents:
diff changeset
    95
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
    96
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
    97
!ViewTreeInspectorApplication class methodsFor:'initialization'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
    98
87bb1815460b initial checkin
ca
parents:
diff changeset
    99
initialize
87bb1815460b initial checkin
ca
parents:
diff changeset
   100
    "add myself to the launcher menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   101
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   102
    self installInLauncher.
87bb1815460b initial checkin
ca
parents:
diff changeset
   103
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   104
87bb1815460b initial checkin
ca
parents:
diff changeset
   105
installInLauncher
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   106
    "add myself to the launcher menu"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   107
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   108
    |menuItem icon|
87bb1815460b initial checkin
ca
parents:
diff changeset
   109
87bb1815460b initial checkin
ca
parents:
diff changeset
   110
    NewLauncher isNil ifTrue:[^ self].
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   111
    "/ cg - disabled. the icon is too ugly.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   112
    ^ self.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   113
87bb1815460b initial checkin
ca
parents:
diff changeset
   114
    icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
87bb1815460b initial checkin
ca
parents:
diff changeset
   115
87bb1815460b initial checkin
ca
parents:
diff changeset
   116
    menuItem := MenuItem new 
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   117
                    label: 'View Tree Inspector';
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   118
                    value: [ ViewTreeInspectorApplication open];
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   119
                    isButton: true;
87bb1815460b initial checkin
ca
parents:
diff changeset
   120
                    icon: icon;
87bb1815460b initial checkin
ca
parents:
diff changeset
   121
                    nameKey: #viewInspect.
87bb1815460b initial checkin
ca
parents:
diff changeset
   122
87bb1815460b initial checkin
ca
parents:
diff changeset
   123
    menuItem startGroup:#right.
87bb1815460b initial checkin
ca
parents:
diff changeset
   124
    NewLauncher addMenuItem:menuItem in:'toolbar'
87bb1815460b initial checkin
ca
parents:
diff changeset
   125
                   position:#( #before #help)
87bb1815460b initial checkin
ca
parents:
diff changeset
   126
                      space:false.
87bb1815460b initial checkin
ca
parents:
diff changeset
   127
87bb1815460b initial checkin
ca
parents:
diff changeset
   128
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   129
self installInLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   130
self removeFromLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   131
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   132
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   133
87bb1815460b initial checkin
ca
parents:
diff changeset
   134
postAutoload
87bb1815460b initial checkin
ca
parents:
diff changeset
   135
    "add myself to the launcher menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   136
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   137
    self installInLauncher.
87bb1815460b initial checkin
ca
parents:
diff changeset
   138
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   139
self installInLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   140
self removeFromLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   141
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   142
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   143
87bb1815460b initial checkin
ca
parents:
diff changeset
   144
removeFromLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   145
    "remove myself from the launcher menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   146
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   147
    NewLauncher isNil ifTrue:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
   148
    NewLauncher removeUserTool:#viewInspect
87bb1815460b initial checkin
ca
parents:
diff changeset
   149
87bb1815460b initial checkin
ca
parents:
diff changeset
   150
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   151
self installInLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   152
self removeFromLauncher
87bb1815460b initial checkin
ca
parents:
diff changeset
   153
"
87bb1815460b initial checkin
ca
parents:
diff changeset
   154
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   155
87bb1815460b initial checkin
ca
parents:
diff changeset
   156
unload
87bb1815460b initial checkin
ca
parents:
diff changeset
   157
    "class is about to be unloaded - remove myself from the launcher menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   158
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   159
    self removeFromLauncher.
87bb1815460b initial checkin
ca
parents:
diff changeset
   160
    super unload.
87bb1815460b initial checkin
ca
parents:
diff changeset
   161
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   162
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   163
!ViewTreeInspectorApplication class methodsFor:'image specs'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   164
2759
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   165
crossHairIcon
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   166
    "This resource specification was automatically generated
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   167
     by the ImageEditor of ST/X."
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   168
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   169
    "Do not manually edit this!! If it is corrupted,
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   170
     the ImageEditor may not be able to read the specification."
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   171
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   172
    "
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   173
     self crossHairIcon inspect
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   174
     ImageEditor openOnClass:self andSelector:#crossHairIcon
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   175
     Icon flushCachedIcons
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   176
    "
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   177
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   178
    <resource: #image>
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   179
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   180
    ^Icon
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   181
        constantNamed:'Tools::ViewTreeInspectorApplication class crossHairIcon'
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   182
        ifAbsentPut:[(Depth1Image new) width: 24; height: 24; photometric:(#palette); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@F0@@XL@@>>@A8O@A>?@B,Z B(J @@@@B(J B,Z A>?@A8O@@>>@@XL@@F0@@@@@@@@@@@@@@@@@@@@@') ; colorMapFromArray:#[255 255 255 0 0 0]; mask:((Depth1Image new) width: 24; height: 24; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@G0@@_<@@?>@A??@C?? C?? G??0G<_0G<_0G<_0G??0C?? C?? A??@@?>@@_<@@G0@@@@@@@@@@@@@@@@@') ; yourself); yourself]
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   183
!
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   184
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   185
pickWindowIcon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   186
    "This resource specification was automatically generated
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   187
     by the ImageEditor of ST/X."
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   188
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   189
    "Do not manually edit this!! If it is corrupted,
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   190
     the ImageEditor may not be able to read the specification."
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   191
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   192
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   193
     self pickWindowIcon inspect
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   194
     ImageEditor openOnClass:self andSelector:#pickWindowIcon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   195
     Icon flushCachedIcons
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   196
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   197
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   198
    <resource: #image>
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   199
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   200
    ^Icon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   201
        constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   202
        ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   203
,;N3,;N3,;N3,;N3,;N3,;N3,;N3,3H<P38;M3P,H2@^GA(VEQHQCP0KA D<[&-%XU=WST%BN#D!!GQ$TD@(IBP\BQF)+Z6E_U4-FPCX+G1,WEA@JBP$HAT23
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   204
,;N3,;N3,;N3,;N$():Z&IRR&1!!^,;N3,;N3,;N3,;N$)JJ^&)"T$),0W[N3,;N3,;N3,;N3,:R"'')*X%IJWK523,;N3,;N3,0@@@KN3)JJ^&)"T$"5Z,;N3
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   205
,;N3@@B3-KL@@JJ^&)"T$)D*V[N3,;N3@KN3-KR4)JH@&)"T$)*MJE"3,;N3,0B3)JJ4&*R"@I*X%IJZ#RYV,;N3,0B3@JR"-JR"-I(@%IJV%H %U[N3,;L@
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   206
-@B4-KR4-KR4@IRR%IJEIER3,;N3@KL@)JJ4():4&@BO#9RR!!RIS,;N3,;L@,:R"-JJ^& BT#8>O#8H"T+N3,;N3@KN$@@@@'')(@%H>O#(>AH%F3,;N3,;L@
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   207
@JR4'' @@%IJO#8>O RIO,;N3,;N3):P@@@BX%IJO#8>O#7<"S*63,;N$():Z&IRR&IRR#8>O#8=>H"&-,;N$():Z&IRR&)"T$(>O#8>O @<)R$!!GQTD?OS$8
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   208
MSL.I2H"H"H"H"HO,;N3,;N3,;N3,;N3,;N3,;N3,;N3,0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 50 164 0 50 171 0 137 0 0 206 0 1 50 177 2 56 178 3 64 241 3 67 246 3 73 255 4 74 255 5 63 191 7 66 194 10 71 196 10 79 255 12 59 167 12 82 255 14 77 199 18 83 201 19 88 255 21 91 255 23 89 204 27 95 206 28 97 255 29 72 179 30 100 255 32 101 209 36 106 255 36 107 211 39 109 255 41 113 214 45 115 255 45 119 216 48 118 255 50 87 176 50 125 219 51 88 176 51 88 177 52 89 178 52 90 178 53 90 178 53 127 212 54 91 179 54 123 255 54 131 221 55 92 180 55 95 181 56 93 180 56 94 181 57 127 255 57 149 229 58 99 184 58 137 224 61 104 187 63 132 255 63 143 226 64 108 190 66 113 193 66 135 255 67 149 229 68 157 232 69 117 196 71 155 231 72 122 199 72 141 255 75 126 202 75 144 255 75 160 234 77 163 236 78 131 206 80 149 255 81 136 209 84 140 212 84 153 255 87 145 215 88 157 255 91 168 235 93 161 255 94 154 222 96 157 223 96 165 255 97 159 225 98 160 225 98 162 226 99 163 227 100 165 228 101 166 229 101 170 255 102 167 230 103 169 231 104 170 232 104 173 255 105 172 233 105 174 234 106 175 235 109 178 255 112 180 255 117 186 255 119 187 255 122 154 245 125 160 253 125 193 255 126 161 253 126 194 255 127 162 254 130 165 254 132 200 255 132 201 255 133 60 36 135 170 255 139 207 255 140 175 255 144 179 255 149 184 255 153 188 255 157 192 255 162 196 255 166 200 255 170 204 255 174 208 255 174 218 230 177 212 255 181 215 255 185 219 255 188 222 255 191 225 255 212 211 224 218 217 230 219 219 230 220 220 231 222 221 232 223 223 233 225 224 234 225 225 234 226 226 237 227 226 235 227 227 236 227 227 238 228 228 237 229 229 239 231 230 238 231 231 238 231 231 240 232 232 241 233 232 239 233 233 240 234 234 242 235 234 241 236 236 243 237 236 242 237 237 244 238 237 243 238 238 244 239 238 243 239 239 245 240 239 244 241 240 245 241 241 246 241 241 247 242 242 246 242 242 247 243 243 247 243 243 248 244 244 248 244 244 249 245 244 247 246 246 249 246 246 250 247 246 249 247 247 250 248 248 251 249 249 250 249 249 251 250 250 251 250 250 252 251 251 252 251 251 253 253 253 254 254 254 255 255 255 255 0 0 0]; mask:((Depth1Image new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@C????????????????????????????????????????????????????????????????????????????????@@@C') ; yourself); yourself]
2759
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   209
!
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   210
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   211
pickWindowIcon2
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   212
    "This resource specification was automatically generated
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   213
     by the ImageEditor of ST/X."
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   214
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   215
    "Do not manually edit this!! If it is corrupted,
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   216
     the ImageEditor may not be able to read the specification."
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   217
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   218
    "
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   219
     self pickWindowIcon2 inspect
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   220
     ImageEditor openOnClass:self andSelector:#pickWindowIcon2
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   221
     Icon flushCachedIcons
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   222
    "
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   223
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   224
    <resource: #image>
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   225
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   226
    ^Icon
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   227
        constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon2'
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   228
        ifAbsentPut:[(Depth8Image new) width: 22; height: 23; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   229
@CH<O#,7MB0#HA8\F!!XUD!!DMC@,F@P@<[&U!!W5]MRTH:LRD]FQPPB $IA0H@QF)+XU=WR4Y@M",_F1\TD@(IBP E@D23,;N3,;N3,;N3,;N"'')*X%IJ[F@A^
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   230
,;N3,;N3,0@@@@@@():Z&IRR&3@@W+N3,;N3@@B3,0B3)@@@&)"T$),0@E63,;N3@KN3@@@@@@B"'' BX%IJWK0A\,;N3@KN3,;N3@JR"'')*X@IRR&24@V+N3
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   231
@KN3,;L@@@@@@I:Z&IP@$),*@E&3,0B3,;N3,:P@():Z&IRT@IJ[J@AX,0B3@KL@,;L@@@B^& BT@IP@&2X@U+L@,0B3@KL@)JJ^@I @%@BT@I,%@EV3@@@@
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   232
@@@@@JR"'' @@@@@@@@B[I@AT,0B3@KL@)@B$()8@&@BZ@IP@&2H@T;L@,0B3@JR$@@@@%I @& BT@I,"@EJ3,0B3,:R$)I8@&IRX%I*X@IJ[H AQ,;L@,:R$
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   233
)@@@@@@@&IRO#0BO RH@S;N3,0B$)JR"'' BX%I"T#0BO#7<"@D:-,;N$@JR$@@@@@@BR#0BO#8=>H AN+[N$)JH@@I"T@I"T@@BO#8>O_"H@JZ63)JJ^&) @
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   234
@@@@@IJO#8>O#8@O@B&3,;N3,;N3,;N3,;N"'')*X%IJ[C0@)R$]EPS<=NS 5L28''H"H"H"H"H <b') ; colorMapFromArray:#[0 0 0 0 50 164 0 50 171 0 137 0 0 206 0 1 50 177 2 56 178 3 64 241 3 67 246 3 73 255 4 74 255 5 63 191 7 66 194 10 71 196 10 79 255 12 59 167 12 82 255 14 77 199 18 83 201 19 88 255 21 91 255 23 89 204 27 95 206 28 97 255 29 72 179 30 100 255 32 101 209 36 106 255 36 107 211 39 109 255 41 113 214 45 115 255 45 119 216 48 118 255 50 87 176 50 125 219 51 88 176 51 88 177 52 89 178 52 90 178 53 90 178 53 127 212 54 91 179 54 123 255 54 131 221 55 92 180 55 95 181 56 93 180 56 94 181 57 127 255 57 149 229 58 99 184 58 137 224 61 104 187 63 132 255 63 143 226 64 108 190 66 113 193 66 135 255 67 149 229 68 157 232 69 117 196 71 155 231 72 122 199 72 141 255 75 126 202 75 144 255 75 160 234 77 163 236 78 131 206 80 149 255 81 136 209 84 140 212 84 153 255 87 145 215 88 157 255 91 168 235 93 161 255 94 154 222 96 157 223 96 165 255 97 159 225 98 160 225 98 162 226 99 163 227 100 165 228 101 166 229 101 170 255 102 167 230 103 169 231 104 170 232 104 173 255 105 172 233 105 174 234 106 175 235 109 178 255 112 180 255 117 186 255 119 187 255 122 154 245 125 160 253 125 193 255 126 161 253 126 194 255 127 162 254 130 165 254 132 200 255 132 201 255 133 60 36 135 170 255 139 207 255 140 175 255 144 179 255 149 184 255 153 188 255 157 192 255 162 196 255 166 200 255 170 204 255 174 208 255 174 218 230 177 212 255 181 215 255 185 219 255 188 222 255 191 225 255 212 211 224 218 217 230 219 219 230 220 220 231 222 221 232 223 223 233 225 224 234 225 225 234 226 226 237 227 226 235 227 227 236 227 227 238 228 228 237 229 229 239 231 230 238 231 231 238 231 231 240 232 232 241 233 232 239 233 233 240 234 234 242 235 234 241 236 236 243 237 236 242 237 237 244 238 237 243 238 238 244 239 238 243 239 239 245 240 239 244 241 240 245 241 241 246 241 241 247 242 242 246 242 242 247 243 243 247 243 243 248 244 244 248 244 244 249 245 244 247 246 246 249 246 246 250 247 246 249 247 247 250 248 248 251 249 249 250 249 249 251 250 250 251 250 250 252 251 251 252 251 251 253 253 253 254 254 254 255 255 255 255]; mask:((Depth1Image new) width: 22; height: 23; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<_??<') ; yourself); yourself]
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   235
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   236
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   237
!ViewTreeInspectorApplication class methodsFor:'interface specs'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   238
87bb1815460b initial checkin
ca
parents:
diff changeset
   239
windowSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
   240
    "This resource specification was automatically generated
87bb1815460b initial checkin
ca
parents:
diff changeset
   241
     by the UIPainter of ST/X."
87bb1815460b initial checkin
ca
parents:
diff changeset
   242
87bb1815460b initial checkin
ca
parents:
diff changeset
   243
    "Do not manually edit this!! If it is corrupted,
87bb1815460b initial checkin
ca
parents:
diff changeset
   244
     the UIPainter may not be able to read the specification."
87bb1815460b initial checkin
ca
parents:
diff changeset
   245
87bb1815460b initial checkin
ca
parents:
diff changeset
   246
    "
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   247
     UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   248
     Tools::ViewTreeInspectorApplication new openInterface:#windowSpec
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   249
     Tools::ViewTreeInspectorApplication open
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   250
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   251
87bb1815460b initial checkin
ca
parents:
diff changeset
   252
    <resource: #canvas>
87bb1815460b initial checkin
ca
parents:
diff changeset
   253
87bb1815460b initial checkin
ca
parents:
diff changeset
   254
    ^ 
87bb1815460b initial checkin
ca
parents:
diff changeset
   255
     #(FullSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
   256
        name: windowSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
   257
        window: 
87bb1815460b initial checkin
ca
parents:
diff changeset
   258
       (WindowSpec
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   259
          label: 'View Tree Inspector'
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   260
          name: 'View Tree Inspector'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   261
          min: (Point 10 10)
87bb1815460b initial checkin
ca
parents:
diff changeset
   262
          max: (Point 1024 9999)
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   263
          bounds: (Rectangle 0 0 381 654)
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   264
          menu: menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   265
        )
87bb1815460b initial checkin
ca
parents:
diff changeset
   266
        component: 
87bb1815460b initial checkin
ca
parents:
diff changeset
   267
       (SpecCollection
87bb1815460b initial checkin
ca
parents:
diff changeset
   268
          collection: (
87bb1815460b initial checkin
ca
parents:
diff changeset
   269
           (MenuPanelSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
   270
              name: 'toolbarMenu'
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   271
              layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   272
              menu: toolbarMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
   273
              textDefault: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   274
            )
87bb1815460b initial checkin
ca
parents:
diff changeset
   275
           (HierarchicalListViewSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
   276
              name: 'List'
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   277
              layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   278
              level: 1
87bb1815460b initial checkin
ca
parents:
diff changeset
   279
              model: model
87bb1815460b initial checkin
ca
parents:
diff changeset
   280
              menu: middleButtonMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
   281
              hasHorizontalScrollBar: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   282
              hasVerticalScrollBar: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   283
              miniScrollerHorizontal: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   284
              miniScrollerVertical: false
87bb1815460b initial checkin
ca
parents:
diff changeset
   285
              listModel: listOfItems
87bb1815460b initial checkin
ca
parents:
diff changeset
   286
              multipleSelectOk: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   287
              useIndex: false
87bb1815460b initial checkin
ca
parents:
diff changeset
   288
              highlightMode: label
87bb1815460b initial checkin
ca
parents:
diff changeset
   289
              showLeftIndicators: false
87bb1815460b initial checkin
ca
parents:
diff changeset
   290
              indicatorSelector: indicatorClicked:
87bb1815460b initial checkin
ca
parents:
diff changeset
   291
              useDefaultIcons: false
87bb1815460b initial checkin
ca
parents:
diff changeset
   292
              postBuildCallback: postBuildTree:
87bb1815460b initial checkin
ca
parents:
diff changeset
   293
            )
87bb1815460b initial checkin
ca
parents:
diff changeset
   294
           )
87bb1815460b initial checkin
ca
parents:
diff changeset
   295
         
87bb1815460b initial checkin
ca
parents:
diff changeset
   296
        )
87bb1815460b initial checkin
ca
parents:
diff changeset
   297
      )
87bb1815460b initial checkin
ca
parents:
diff changeset
   298
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   299
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   300
!ViewTreeInspectorApplication class methodsFor:'menu specs'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   301
87bb1815460b initial checkin
ca
parents:
diff changeset
   302
menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   303
    "This resource specification was automatically generated
87bb1815460b initial checkin
ca
parents:
diff changeset
   304
     by the MenuEditor of ST/X."
87bb1815460b initial checkin
ca
parents:
diff changeset
   305
87bb1815460b initial checkin
ca
parents:
diff changeset
   306
    "Do not manually edit this!! If it is corrupted,
87bb1815460b initial checkin
ca
parents:
diff changeset
   307
     the MenuEditor may not be able to read the specification."
87bb1815460b initial checkin
ca
parents:
diff changeset
   308
87bb1815460b initial checkin
ca
parents:
diff changeset
   309
    "
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   310
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   311
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   312
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   313
87bb1815460b initial checkin
ca
parents:
diff changeset
   314
    <resource: #menu>
87bb1815460b initial checkin
ca
parents:
diff changeset
   315
87bb1815460b initial checkin
ca
parents:
diff changeset
   316
    ^ 
87bb1815460b initial checkin
ca
parents:
diff changeset
   317
     #(Menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   318
        (
87bb1815460b initial checkin
ca
parents:
diff changeset
   319
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   320
            label: 'File'
87bb1815460b initial checkin
ca
parents:
diff changeset
   321
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   322
            submenu: 
87bb1815460b initial checkin
ca
parents:
diff changeset
   323
           (Menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   324
              (
87bb1815460b initial checkin
ca
parents:
diff changeset
   325
               (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   326
                  label: 'Pick a View'
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
   327
                  itemValue: doPickView
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   328
                  translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   329
                )
87bb1815460b initial checkin
ca
parents:
diff changeset
   330
               (MenuItem
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   331
                  enabled: hasTargetWidgetChannel
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   332
                  label: 'Release Picked View'
87bb1815460b initial checkin
ca
parents:
diff changeset
   333
                  itemValue: doUnpick
87bb1815460b initial checkin
ca
parents:
diff changeset
   334
                  translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   335
                )
87bb1815460b initial checkin
ca
parents:
diff changeset
   336
               (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   337
                  label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   338
                )
87bb1815460b initial checkin
ca
parents:
diff changeset
   339
               (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   340
                  label: 'Settings'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   341
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   342
                  submenu: 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   343
                 (Menu
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   344
                    (
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   345
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   346
                        label: 'Test Mode'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   347
                        translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   348
                        hideMenuOnActivated: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   349
                        indication: testModeChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   350
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   351
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   352
                        enabled: testModeChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   353
                        label: 'Follow Focus'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   354
                        translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   355
                        hideMenuOnActivated: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   356
                        indication: followFocusChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   357
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   358
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   359
                        label: '-'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   360
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   361
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   362
                        label: 'Select on Click'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   363
                        translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   364
                        hideMenuOnActivated: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   365
                        indication: selectOnClickHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   366
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   367
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   368
                        label: '-'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   369
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   370
                     (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   371
                        label: 'Show Name of Widgets'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   372
                        translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   373
                        hideMenuOnActivated: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   374
                        indication: showNamesHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   375
                      )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   376
                     )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   377
                    nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   378
                    nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   379
                  )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   380
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   381
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   382
                  label: '-'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   383
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   384
               (MenuItem
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   385
                  label: 'Exit'
87bb1815460b initial checkin
ca
parents:
diff changeset
   386
                  itemValue: closeRequest
87bb1815460b initial checkin
ca
parents:
diff changeset
   387
                  translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   388
                )
87bb1815460b initial checkin
ca
parents:
diff changeset
   389
               )
87bb1815460b initial checkin
ca
parents:
diff changeset
   390
              nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   391
              nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   392
            )
87bb1815460b initial checkin
ca
parents:
diff changeset
   393
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   394
         (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   395
            enabled: hasSingleSelectionHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   396
            label: 'Selection'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   397
            translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   398
            submenuChannel: middleButtonMenu
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   399
          )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   400
         (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   401
            label: 'Application'
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   402
            translateLabel: true
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   403
            submenu: 
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   404
           (Menu
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   405
              (
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   406
               (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   407
                  enabled: hasSingleSelectionHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   408
                  label: 'Browse'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   409
                  itemValue: doBrowse:
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   410
                  translateLabel: true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   411
                  argument: application
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   412
                )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   413
               (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   414
                  enabled: hasSingleSelectionHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   415
                  label: 'Inspect'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   416
                  itemValue: doInspect:
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   417
                  translateLabel: true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   418
                  argument: application
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   419
                )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   420
               (MenuItem
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   421
                  label: '-'
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   422
                )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   423
               (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   424
                  enabled: hasTargetWidgetChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   425
                  label: 'All Applications'
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   426
                  translateLabel: true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   427
                  submenuChannel: submenuApplications:
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   428
                )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   429
               )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   430
              nil
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   431
              nil
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   432
            )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   433
          )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   434
         (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   435
            label: 'Widget'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   436
            translateLabel: true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   437
            submenu: 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   438
           (Menu
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   439
              (
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   440
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   441
                  enabled: hasSingleSelectionHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   442
                  label: 'Browse'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   443
                  itemValue: doBrowse:
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   444
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   445
                  argument: view
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   446
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   447
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   448
                  enabled: hasSingleSelectionHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   449
                  label: 'Inspect'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   450
                  itemValue: doInspect:
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   451
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   452
                  argument: view
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   453
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   454
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   455
                  label: '-'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   456
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   457
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   458
                  enabled: hasTargetWidgetChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   459
                  label: 'All Components'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   460
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   461
                  startGroup: right
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   462
                  submenuChannel: submenuComponents:
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   463
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   464
               )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   465
              nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   466
              nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   467
            )
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   468
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   469
         (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   470
            label: 'Help'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   471
            translateLabel: true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   472
            startGroup: conditionalRight
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   473
            submenu: 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   474
           (Menu
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   475
              (
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   476
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   477
                  label: 'Documentation'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   478
                  itemValue: openDocumentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   479
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   480
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   481
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   482
                  label: '-'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   483
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   484
               (MenuItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   485
                  label: 'About this Application...'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   486
                  itemValue: openAboutThisApplication
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   487
                  translateLabel: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   488
                )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   489
               )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   490
              nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   491
              nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   492
            )
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   493
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   494
         )
87bb1815460b initial checkin
ca
parents:
diff changeset
   495
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   496
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   497
      )
87bb1815460b initial checkin
ca
parents:
diff changeset
   498
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   499
87bb1815460b initial checkin
ca
parents:
diff changeset
   500
middleButtonMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
   501
    "This resource specification was automatically generated
87bb1815460b initial checkin
ca
parents:
diff changeset
   502
     by the MenuEditor of ST/X."
87bb1815460b initial checkin
ca
parents:
diff changeset
   503
87bb1815460b initial checkin
ca
parents:
diff changeset
   504
    "Do not manually edit this!! If it is corrupted,
87bb1815460b initial checkin
ca
parents:
diff changeset
   505
     the MenuEditor may not be able to read the specification."
87bb1815460b initial checkin
ca
parents:
diff changeset
   506
87bb1815460b initial checkin
ca
parents:
diff changeset
   507
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   508
     MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
   509
     (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
87bb1815460b initial checkin
ca
parents:
diff changeset
   510
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   511
87bb1815460b initial checkin
ca
parents:
diff changeset
   512
    <resource: #menu>
87bb1815460b initial checkin
ca
parents:
diff changeset
   513
87bb1815460b initial checkin
ca
parents:
diff changeset
   514
    ^ 
87bb1815460b initial checkin
ca
parents:
diff changeset
   515
     #(Menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   516
        (
87bb1815460b initial checkin
ca
parents:
diff changeset
   517
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   518
            label: 'Geometry'
87bb1815460b initial checkin
ca
parents:
diff changeset
   519
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   520
            submenuChannel: submenuGeometry:
87bb1815460b initial checkin
ca
parents:
diff changeset
   521
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   522
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   523
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   524
            label: 'Interface'
87bb1815460b initial checkin
ca
parents:
diff changeset
   525
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   526
            submenuChannel: submenuInterface:
87bb1815460b initial checkin
ca
parents:
diff changeset
   527
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   528
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   529
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   530
            label: 'Visibility'
87bb1815460b initial checkin
ca
parents:
diff changeset
   531
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   532
            submenuChannel: submenuVisibility:
87bb1815460b initial checkin
ca
parents:
diff changeset
   533
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   534
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   535
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   536
            label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   537
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   538
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   539
            label: 'Browse View Class'
87bb1815460b initial checkin
ca
parents:
diff changeset
   540
            itemValue: doBrowse:
87bb1815460b initial checkin
ca
parents:
diff changeset
   541
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   542
            argument: view
87bb1815460b initial checkin
ca
parents:
diff changeset
   543
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   544
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   545
            label: 'Browse Model Class'
87bb1815460b initial checkin
ca
parents:
diff changeset
   546
            itemValue: doBrowse:
87bb1815460b initial checkin
ca
parents:
diff changeset
   547
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   548
            isVisible: hasModel
87bb1815460b initial checkin
ca
parents:
diff changeset
   549
            argument: model
87bb1815460b initial checkin
ca
parents:
diff changeset
   550
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   551
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   552
            label: 'Browse Application Class'
87bb1815460b initial checkin
ca
parents:
diff changeset
   553
            itemValue: doBrowse:
87bb1815460b initial checkin
ca
parents:
diff changeset
   554
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   555
            isVisible: hasApplication
87bb1815460b initial checkin
ca
parents:
diff changeset
   556
            argument: application
87bb1815460b initial checkin
ca
parents:
diff changeset
   557
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   558
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   559
            label: 'Browse Controller Class'
87bb1815460b initial checkin
ca
parents:
diff changeset
   560
            itemValue: doBrowse:
87bb1815460b initial checkin
ca
parents:
diff changeset
   561
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   562
            isVisible: hasController
87bb1815460b initial checkin
ca
parents:
diff changeset
   563
            argument: controller
87bb1815460b initial checkin
ca
parents:
diff changeset
   564
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   565
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   566
            label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   567
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   568
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   569
            label: 'Inspect View'
87bb1815460b initial checkin
ca
parents:
diff changeset
   570
            itemValue: doInspect:
87bb1815460b initial checkin
ca
parents:
diff changeset
   571
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   572
            argument: view
87bb1815460b initial checkin
ca
parents:
diff changeset
   573
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   574
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   575
            label: 'Inspect Window Group'
87bb1815460b initial checkin
ca
parents:
diff changeset
   576
            itemValue: doInspect:
87bb1815460b initial checkin
ca
parents:
diff changeset
   577
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   578
            argument: group
87bb1815460b initial checkin
ca
parents:
diff changeset
   579
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   580
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   581
            label: 'Inspect Model'
87bb1815460b initial checkin
ca
parents:
diff changeset
   582
            itemValue: doInspect:
87bb1815460b initial checkin
ca
parents:
diff changeset
   583
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   584
            isVisible: hasModel
87bb1815460b initial checkin
ca
parents:
diff changeset
   585
            argument: model
87bb1815460b initial checkin
ca
parents:
diff changeset
   586
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   587
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   588
            label: 'Inspect Application'
87bb1815460b initial checkin
ca
parents:
diff changeset
   589
            itemValue: doInspect:
87bb1815460b initial checkin
ca
parents:
diff changeset
   590
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   591
            isVisible: hasApplication
87bb1815460b initial checkin
ca
parents:
diff changeset
   592
            argument: application
87bb1815460b initial checkin
ca
parents:
diff changeset
   593
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   594
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   595
            label: 'Inspect Controller'
87bb1815460b initial checkin
ca
parents:
diff changeset
   596
            itemValue: doInspect:
87bb1815460b initial checkin
ca
parents:
diff changeset
   597
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   598
            isVisible: hasController
87bb1815460b initial checkin
ca
parents:
diff changeset
   599
            argument: controller
87bb1815460b initial checkin
ca
parents:
diff changeset
   600
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   601
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   602
            label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   603
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   604
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   605
            label: 'Flash'
87bb1815460b initial checkin
ca
parents:
diff changeset
   606
            itemValue: doFlash
87bb1815460b initial checkin
ca
parents:
diff changeset
   607
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   608
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   609
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   610
            label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   611
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   612
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   613
            label: 'Destroy'
87bb1815460b initial checkin
ca
parents:
diff changeset
   614
            itemValue: doDestroy
87bb1815460b initial checkin
ca
parents:
diff changeset
   615
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   616
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   617
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   618
            label: '-'
87bb1815460b initial checkin
ca
parents:
diff changeset
   619
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   620
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   621
            label: 'Instance Variables'
87bb1815460b initial checkin
ca
parents:
diff changeset
   622
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   623
            submenuChannel: submenuInspector:
87bb1815460b initial checkin
ca
parents:
diff changeset
   624
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   625
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   626
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   627
            label: '='
87bb1815460b initial checkin
ca
parents:
diff changeset
   628
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   629
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   630
            label: ''
87bb1815460b initial checkin
ca
parents:
diff changeset
   631
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   632
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   633
            enabled: selectedComponentHasChildren
87bb1815460b initial checkin
ca
parents:
diff changeset
   634
            label: 'Applications'
87bb1815460b initial checkin
ca
parents:
diff changeset
   635
            nameKey: single
87bb1815460b initial checkin
ca
parents:
diff changeset
   636
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   637
            submenuChannel: submenuApplications:
87bb1815460b initial checkin
ca
parents:
diff changeset
   638
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   639
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   640
         (MenuItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   641
            enabled: selectedComponentHasChildren
87bb1815460b initial checkin
ca
parents:
diff changeset
   642
            label: 'Components'
87bb1815460b initial checkin
ca
parents:
diff changeset
   643
            nameKey: single
87bb1815460b initial checkin
ca
parents:
diff changeset
   644
            translateLabel: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   645
            submenuChannel: submenuComponents:
87bb1815460b initial checkin
ca
parents:
diff changeset
   646
            keepLinkedMenu: true
87bb1815460b initial checkin
ca
parents:
diff changeset
   647
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   648
         )
87bb1815460b initial checkin
ca
parents:
diff changeset
   649
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   650
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   651
      )
87bb1815460b initial checkin
ca
parents:
diff changeset
   652
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   653
87bb1815460b initial checkin
ca
parents:
diff changeset
   654
toolbarMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
   655
    "This resource specification was automatically generated
87bb1815460b initial checkin
ca
parents:
diff changeset
   656
     by the MenuEditor of ST/X."
87bb1815460b initial checkin
ca
parents:
diff changeset
   657
87bb1815460b initial checkin
ca
parents:
diff changeset
   658
    "Do not manually edit this!! If it is corrupted,
87bb1815460b initial checkin
ca
parents:
diff changeset
   659
     the MenuEditor may not be able to read the specification."
87bb1815460b initial checkin
ca
parents:
diff changeset
   660
87bb1815460b initial checkin
ca
parents:
diff changeset
   661
    "
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   662
     MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   663
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   664
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
   665
87bb1815460b initial checkin
ca
parents:
diff changeset
   666
    <resource: #menu>
87bb1815460b initial checkin
ca
parents:
diff changeset
   667
87bb1815460b initial checkin
ca
parents:
diff changeset
   668
    ^ 
87bb1815460b initial checkin
ca
parents:
diff changeset
   669
     #(Menu
87bb1815460b initial checkin
ca
parents:
diff changeset
   670
        (
87bb1815460b initial checkin
ca
parents:
diff changeset
   671
         (MenuItem
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   672
            label: 'Pick a View'
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
   673
            itemValue: doPickView
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   674
            translateLabel: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   675
            isButton: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   676
            hideMenuOnActivated: false
2759
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
   677
            labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon2)
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   678
          )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   679
         (MenuItem
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   680
            enabled: hasTargetWidgetChannel
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   681
            label: 'Release Picked View'
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   682
            isButton: true
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   683
            itemValue: doUnpick
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   684
            translateLabel: true
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   685
            labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   686
          )
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   687
         (MenuItem
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   688
            label: '-'
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   689
          )
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
   690
         (MenuItem
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   691
            enabled: hasSingleSelectionHolder
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   692
            label: 'Browse Application'
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   693
            itemValue: doBrowse:
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   694
            translateLabel: false
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   695
            isButton: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   696
            hideMenuOnActivated: false
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   697
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   698
            argument: application
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   699
          )
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   700
         (MenuItem
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   701
            enabled: hasSingleSelectionHolder
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   702
            label: 'Inspect Application'
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   703
            itemValue: doInspect:
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   704
            translateLabel: false
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   705
            isButton: true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   706
            hideMenuOnActivated: false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   707
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   708
            argument: application
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   709
          )
87bb1815460b initial checkin
ca
parents:
diff changeset
   710
         )
87bb1815460b initial checkin
ca
parents:
diff changeset
   711
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   712
        nil
87bb1815460b initial checkin
ca
parents:
diff changeset
   713
      )
87bb1815460b initial checkin
ca
parents:
diff changeset
   714
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   715
2747
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   716
!ViewTreeInspectorApplication class methodsFor:'startup'!
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   717
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   718
openInPickMode
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   719
    |app|
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   720
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   721
    app := self new.
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   722
    app open.
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
   723
    app doPickView.
2747
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   724
! !
717a0dcc710d added: #openInPickMode
Claus Gittinger <cg@exept.de>
parents: 2744
diff changeset
   725
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   726
!ViewTreeInspectorApplication methodsFor:'actions'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   727
87bb1815460b initial checkin
ca
parents:
diff changeset
   728
indicatorClicked:anIndex
87bb1815460b initial checkin
ca
parents:
diff changeset
   729
    |item sensor|
87bb1815460b initial checkin
ca
parents:
diff changeset
   730
87bb1815460b initial checkin
ca
parents:
diff changeset
   731
    item := model listOfItems at:anIndex ifAbsent:nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
   732
87bb1815460b initial checkin
ca
parents:
diff changeset
   733
    item notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   734
        (     (sensor := self window sensor) notNil
87bb1815460b initial checkin
ca
parents:
diff changeset
   735
         and:[(sensor ctrlDown or:[sensor shiftDown])]
87bb1815460b initial checkin
ca
parents:
diff changeset
   736
        ) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   737
            item recursiveToggleExpand
87bb1815460b initial checkin
ca
parents:
diff changeset
   738
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   739
            item toggleExpand
87bb1815460b initial checkin
ca
parents:
diff changeset
   740
        ]
87bb1815460b initial checkin
ca
parents:
diff changeset
   741
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   742
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   743
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   744
!ViewTreeInspectorApplication methodsFor:'aspects'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   745
87bb1815460b initial checkin
ca
parents:
diff changeset
   746
followFocusChannel
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   747
    "boolean holder, which indicates whether selection changed dependend on the focus view"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   748
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   749
    ^ followFocusChannel
87bb1815460b initial checkin
ca
parents:
diff changeset
   750
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   751
87bb1815460b initial checkin
ca
parents:
diff changeset
   752
hasSingleSelectionHolder
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   753
    "boolean holder, true if one item is selected"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   754
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   755
    ^ hasSingleSelectionHolder
87bb1815460b initial checkin
ca
parents:
diff changeset
   756
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   757
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   758
hasTargetWidgetChannel
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   759
    "answer the channel which is set to true if a target widget exists"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   760
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   761
    ^ model hasTargetWidgetChannel
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   762
!
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   763
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   764
listOfItems
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   765
    "returns the hierarchical list of items"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   766
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   767
    ^ model listOfItems
87bb1815460b initial checkin
ca
parents:
diff changeset
   768
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   769
87bb1815460b initial checkin
ca
parents:
diff changeset
   770
model
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   771
    "returns my selection model, a ViewTreeModel"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   772
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   773
    ^ model
87bb1815460b initial checkin
ca
parents:
diff changeset
   774
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   775
87bb1815460b initial checkin
ca
parents:
diff changeset
   776
selectOnClickHolder
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   777
    "boolean holder, which indicates whether the selection will change on click"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   778
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   779
    ^ model selectOnClickHolder
87bb1815460b initial checkin
ca
parents:
diff changeset
   780
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   781
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   782
showNamesHolder
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   783
    "boolean holder, which indicates whether application names or widget names
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   784
     as additional text are shown for the items"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   785
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   786
    ^ showNamesHolder
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   787
!
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   788
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   789
testModeChannel
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   790
    "answer a boolean channel which describes the behaviour how to process
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   791
     events on the target view.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   792
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   793
     false: all input events are eaten and the selection is shown on the target view.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   794
     true:  no  input events are eaten and no  selection is shown on the target view."
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   795
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   796
    ^ model testModeChannel
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   797
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   798
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   799
!ViewTreeInspectorApplication methodsFor:'change & update'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   800
87bb1815460b initial checkin
ca
parents:
diff changeset
   801
selectionChanged
87bb1815460b initial checkin
ca
parents:
diff changeset
   802
    |info view item|
87bb1815460b initial checkin
ca
parents:
diff changeset
   803
87bb1815460b initial checkin
ca
parents:
diff changeset
   804
    item := model selectedItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
   805
87bb1815460b initial checkin
ca
parents:
diff changeset
   806
    item notNil ifTrue:[ |state|
87bb1815460b initial checkin
ca
parents:
diff changeset
   807
        view := item widget.
87bb1815460b initial checkin
ca
parents:
diff changeset
   808
87bb1815460b initial checkin
ca
parents:
diff changeset
   809
        view id isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   810
            state := 'no ID'.
87bb1815460b initial checkin
ca
parents:
diff changeset
   811
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   812
            view shown ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   813
                state := 'visible'.
87bb1815460b initial checkin
ca
parents:
diff changeset
   814
            ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   815
                state := 'invisible'
87bb1815460b initial checkin
ca
parents:
diff changeset
   816
            ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   817
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   818
        info := '%1 [%2] - %3' bindWith:(view class name)
87bb1815460b initial checkin
ca
parents:
diff changeset
   819
                                   with:(view name ? '') with:state allBold.
87bb1815460b initial checkin
ca
parents:
diff changeset
   820
87bb1815460b initial checkin
ca
parents:
diff changeset
   821
    ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   822
        info := ''
87bb1815460b initial checkin
ca
parents:
diff changeset
   823
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   824
    hasSingleSelectionHolder value:(view notNil).
87bb1815460b initial checkin
ca
parents:
diff changeset
   825
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   826
87bb1815460b initial checkin
ca
parents:
diff changeset
   827
update:something with:someArgument from:aModel
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   828
    |oldSelection|
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   829
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   830
    aModel == showNamesHolder ifTrue:[
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   831
        oldSelection := model selectedItem.
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   832
        model selectedItem:nil.
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   833
        self listOfItems showWidgetNames:(aModel value).
2454
4867f3e9dd43 *** empty log message ***
ca
parents: 2451
diff changeset
   834
        model selectedItem:oldSelection.
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   835
        ^ self
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
   836
    ].
2458
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   837
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   838
    aModel == model ifTrue:[
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   839
        self selectionChanged.
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   840
        ^ self
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   841
    ].
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
   842
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   843
    super update:something with:someArgument from:aModel.
87bb1815460b initial checkin
ca
parents:
diff changeset
   844
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
   845
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
   846
!ViewTreeInspectorApplication methodsFor:'event processing'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   847
87bb1815460b initial checkin
ca
parents:
diff changeset
   848
processButtonMotionEvent:ev
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   849
    |click rootView|
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   850
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   851
    motionAction isNil ifTrue:[^ self].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   852
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   853
    (rootView := model rootView) isNil ifTrue:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   854
        clickedItem := motionAction := nil.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   855
        ^ self
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   856
    ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   857
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   858
    click := rootView device
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   859
            translatePoint:((ev x)@ (ev y))
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   860
            fromView:(ev view)
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   861
            toView:rootView.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   862
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   863
    click = clickedPoint ifFalse:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   864
        (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   865
            motionAction value:click
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   866
        ]
87bb1815460b initial checkin
ca
parents:
diff changeset
   867
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   868
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   869
87bb1815460b initial checkin
ca
parents:
diff changeset
   870
processButtonPressEvent:ev
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   871
    |rootView sensor lastRectangle|
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   872
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   873
    rootView    := model rootView.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   874
    sensor      := model rootView sensor.
87bb1815460b initial checkin
ca
parents:
diff changeset
   875
    clickedItem := model listOfItems detectItemRespondsToView:(ev view).
87bb1815460b initial checkin
ca
parents:
diff changeset
   876
87bb1815460b initial checkin
ca
parents:
diff changeset
   877
    (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   878
        clickedItem notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   879
            self selectOnClickHolder value ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   880
                model toggleSelectItem:clickedItem
87bb1815460b initial checkin
ca
parents:
diff changeset
   881
            ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   882
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   883
        clickedItem := motionAction := nil.
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   884
        ^ self
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   885
    ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   886
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   887
    clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   888
    lastRectangle := nil.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   889
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   890
    motionAction :=[:p|
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   891
        rootView    := model rootView device rootView.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   892
        rootView    := model rootView.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   893
        clickedItem := nil.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   894
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   895
        rootView xoring:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   896
            lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   897
                                ifFalse:[ rootView clippedByChildren:false ].
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   898
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   899
            p isNil ifTrue:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   900
                rootView clippedByChildren:true.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   901
                motionAction := nil.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   902
            ] ifFalse:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   903
                lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   904
                rootView displayRectangle:lastRectangle.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   905
            ].
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   906
            rootView flush.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   907
        ].
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   908
        lastRectangle
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   909
    ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   910
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   911
87bb1815460b initial checkin
ca
parents:
diff changeset
   912
processButtonReleaseEvent:anEvent
87bb1815460b initial checkin
ca
parents:
diff changeset
   913
    |rootView rectangle newItems widget origin|
87bb1815460b initial checkin
ca
parents:
diff changeset
   914
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   915
    (rootView := model rootView) isNil ifTrue:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   916
        clickedItem := motionAction := nil.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   917
        ^ self
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   918
    ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   919
    motionAction isNil ifTrue:[ ^ self ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   920
    clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   921
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   922
    rectangle := motionAction value:nil.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   923
    rectangle isNil ifTrue:[^ self].
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   924
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   925
    newItems := OrderedCollection new.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   926
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   927
    model rootItem recursiveDo:[:anItem|
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   928
        widget := anItem widget.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   929
        origin := widget originRelativeTo:rootView.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   930
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   931
        (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   932
            newItems add:anItem.
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   933
        ]
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   934
    ].
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
   935
    model value:newItems.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   936
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   937
87bb1815460b initial checkin
ca
parents:
diff changeset
   938
processEvent:anEvent
87bb1815460b initial checkin
ca
parents:
diff changeset
   939
    |button menu|
87bb1815460b initial checkin
ca
parents:
diff changeset
   940
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   941
    anEvent isKeyPressEvent ifTrue:[ self processKeyPressEvent:anEvent. ^ self  ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   942
    anEvent isButtonEvent  ifFalse:[ ^ self ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   943
87bb1815460b initial checkin
ca
parents:
diff changeset
   944
    button := anEvent button.
87bb1815460b initial checkin
ca
parents:
diff changeset
   945
87bb1815460b initial checkin
ca
parents:
diff changeset
   946
    (button == 2 or:[button == #menu]) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   947
        motionAction isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   948
            anEvent isButtonPressEvent ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   949
                self selectOnClickHolder value ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   950
                    menu := self middleButtonMenu value.
87bb1815460b initial checkin
ca
parents:
diff changeset
   951
                    menu notNil ifTrue:[
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   952
                        menu := MenuPanel 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   953
                                    menu:(Menu new fromLiteralArrayEncoding:menu)
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   954
                                    receiver:self.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   955
                        menu startUp.
87bb1815460b initial checkin
ca
parents:
diff changeset
   956
                    ]
87bb1815460b initial checkin
ca
parents:
diff changeset
   957
                ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   958
            ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   959
            clickedItem := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
   960
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   961
        ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
   962
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   963
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   964
    anEvent isButtonPressEvent  ifTrue:[ self processButtonPressEvent:anEvent. ^ self ].
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
   965
    anEvent isButtonMotionEvent ifTrue:[ self processButtonMotionEvent:anEvent. ^ self ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
   966
87bb1815460b initial checkin
ca
parents:
diff changeset
   967
    anEvent isButtonReleaseEvent ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   968
        self selectOnClickHolder value ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   969
            self processButtonReleaseEvent:anEvent
87bb1815460b initial checkin
ca
parents:
diff changeset
   970
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   971
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   972
    clickedItem := motionAction := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
   973
87bb1815460b initial checkin
ca
parents:
diff changeset
   974
    anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   975
        self selectOnClickHolder value ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   976
            self doInspect:#view.
87bb1815460b initial checkin
ca
parents:
diff changeset
   977
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   978
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   979
!
87bb1815460b initial checkin
ca
parents:
diff changeset
   980
87bb1815460b initial checkin
ca
parents:
diff changeset
   981
processKeyPressEvent:anEvent
87bb1815460b initial checkin
ca
parents:
diff changeset
   982
    |item prnt idx key max next|
87bb1815460b initial checkin
ca
parents:
diff changeset
   983
87bb1815460b initial checkin
ca
parents:
diff changeset
   984
    key := anEvent key.
87bb1815460b initial checkin
ca
parents:
diff changeset
   985
    key isSymbol ifFalse:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
   986
87bb1815460b initial checkin
ca
parents:
diff changeset
   987
    key == #Delete    ifTrue:[ ^ self doDestroy ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   988
    key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   989
87bb1815460b initial checkin
ca
parents:
diff changeset
   990
    (   key == #CursorUp
87bb1815460b initial checkin
ca
parents:
diff changeset
   991
    or:[key == #CursorDown
87bb1815460b initial checkin
ca
parents:
diff changeset
   992
    or:[key == #CursorLeft
87bb1815460b initial checkin
ca
parents:
diff changeset
   993
    or:[key == #CursorRight]]]
87bb1815460b initial checkin
ca
parents:
diff changeset
   994
    ) ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
   995
        ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
   996
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
   997
    item := model selectedItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
   998
87bb1815460b initial checkin
ca
parents:
diff changeset
   999
    item isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1000
        ^ model selectedItem:(model first ? model rootItem)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1001
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1002
87bb1815460b initial checkin
ca
parents:
diff changeset
  1003
    prnt := item parent.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1004
    prnt isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1005
        "/ is the root item
87bb1815460b initial checkin
ca
parents:
diff changeset
  1006
        (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1007
                                                  ifFalse:[item := item at:1 ifAbsent:item].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1008
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1009
        ^ model selectedItem:item
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1010
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1011
    key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1012
87bb1815460b initial checkin
ca
parents:
diff changeset
  1013
    key == #CursorRight ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1014
        next := item at:1 ifAbsent:nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1015
        next notNil ifTrue:[ model selectedItem:next ].
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1016
        ^ self
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1017
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1018
87bb1815460b initial checkin
ca
parents:
diff changeset
  1019
    max := prnt size.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1020
87bb1815460b initial checkin
ca
parents:
diff changeset
  1021
    key == #CursorUp ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1022
        idx := prnt identityIndexOf:item.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1023
        idx == 1 ifTrue:[idx := max + 1].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1024
        model selectedItem:(prnt at:idx - 1).
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1025
        ^ self.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1026
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1027
87bb1815460b initial checkin
ca
parents:
diff changeset
  1028
    key == #CursorDown ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1029
        idx := prnt identityIndexOf:item.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1030
        idx == max ifTrue:[idx := 0].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1031
        model selectedItem:(prnt at:idx + 1).
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1032
        ^ self.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1033
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1034
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1035
87bb1815460b initial checkin
ca
parents:
diff changeset
  1036
processMappedView:aView
87bb1815460b initial checkin
ca
parents:
diff changeset
  1037
    |parent anchor|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1038
87bb1815460b initial checkin
ca
parents:
diff changeset
  1039
    parent := self listOfItems detectItemRespondsToView:aView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1040
    parent isNil ifTrue:[ ^ self ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1041
87bb1815460b initial checkin
ca
parents:
diff changeset
  1042
    NotFoundSignal handle:[:ex|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1043
        "contained subvies used by spec are not yet created;
87bb1815460b initial checkin
ca
parents:
diff changeset
  1044
         thus we have to wait until last used subview is build
87bb1815460b initial checkin
ca
parents:
diff changeset
  1045
        "
87bb1815460b initial checkin
ca
parents:
diff changeset
  1046
        anchor := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1047
    ] do:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1048
        anchor := parent class buildViewsFrom:(parent widget).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1049
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1050
    anchor notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1051
        parent updateFromChildren:anchor children.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1052
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1053
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1054
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1055
!ViewTreeInspectorApplication methodsFor:'initialization & release'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1056
87bb1815460b initial checkin
ca
parents:
diff changeset
  1057
closeDownViews
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1058
    "release the grapped application"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1059
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1060
    process := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1061
    super closeDownViews.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1062
    self doUnpick.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1063
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1064
87bb1815460b initial checkin
ca
parents:
diff changeset
  1065
initialize
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1066
    "setup my model and channels"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1067
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1068
    super initialize.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1069
87bb1815460b initial checkin
ca
parents:
diff changeset
  1070
    hasSingleSelectionHolder := false asValue.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1071
    followFocusChannel       := false asValue.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1072
87bb1815460b initial checkin
ca
parents:
diff changeset
  1073
    model := ViewTreeModel new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1074
    model inputEventAction:[:ev| self processEvent:ev ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1075
    model mappedViewAction:[:vw| self processMappedView:vw ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1076
    model application:self.
2458
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
  1077
    model addDependent:self.
64d8f3c973b3 *** empty log message ***
ca
parents: 2455
diff changeset
  1078
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1079
2451
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
  1080
    showNamesHolder := false asValue.
cbda60900ced *** empty log message ***
ca
parents: 2177
diff changeset
  1081
    showNamesHolder addDependent:self.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1082
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1083
87bb1815460b initial checkin
ca
parents:
diff changeset
  1084
postBuildTree:aTree
87bb1815460b initial checkin
ca
parents:
diff changeset
  1085
    treeView := aTree scrolledView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1086
    treeView hasConstantHeight:true.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1087
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1088
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1089
!ViewTreeInspectorApplication methodsFor:'menu queries'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1090
87bb1815460b initial checkin
ca
parents:
diff changeset
  1091
hasApplication
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1092
    "returns true if the current selected view has an application"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1093
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1094
    |view|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1095
87bb1815460b initial checkin
ca
parents:
diff changeset
  1096
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1097
  ^ (view notNil and:[view application notNil])
87bb1815460b initial checkin
ca
parents:
diff changeset
  1098
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1099
87bb1815460b initial checkin
ca
parents:
diff changeset
  1100
hasController
87bb1815460b initial checkin
ca
parents:
diff changeset
  1101
    "returns true if the current selected item's view has a controller
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1102
     other than nil or the view itself"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1103
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1104
    |view controller|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1105
87bb1815460b initial checkin
ca
parents:
diff changeset
  1106
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1107
87bb1815460b initial checkin
ca
parents:
diff changeset
  1108
    view notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1109
        controller := view controller.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1110
      ^ (controller notNil and:[controller ~~ view])
87bb1815460b initial checkin
ca
parents:
diff changeset
  1111
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1112
    ^ false
87bb1815460b initial checkin
ca
parents:
diff changeset
  1113
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1114
87bb1815460b initial checkin
ca
parents:
diff changeset
  1115
hasModel
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1116
    "returns true if the current selected view has a model"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1117
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1118
    |view|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1119
87bb1815460b initial checkin
ca
parents:
diff changeset
  1120
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1121
  ^ (view notNil and:[view model notNil])
87bb1815460b initial checkin
ca
parents:
diff changeset
  1122
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1123
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1124
!ViewTreeInspectorApplication methodsFor:'menu specs'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1125
87bb1815460b initial checkin
ca
parents:
diff changeset
  1126
middleButtonMenu
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1127
    "returns the middleButton menu for the single selected item or nil"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1128
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1129
    ^ [ 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1130
        model selectedItem notNil 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1131
            ifTrue:[self class middleButtonMenu]
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1132
            ifFalse:[nil]
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1133
      ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1134
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1135
87bb1815460b initial checkin
ca
parents:
diff changeset
  1136
submenuApplications:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1137
    |applications menu item list addBlock|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1138
87bb1815460b initial checkin
ca
parents:
diff changeset
  1139
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1140
                                              ifFalse:[model rootItem].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1141
    item isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1142
87bb1815460b initial checkin
ca
parents:
diff changeset
  1143
    applications := IdentityDictionary new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1144
87bb1815460b initial checkin
ca
parents:
diff changeset
  1145
    addBlock := [:el| |cls ctr|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1146
        cls := self resolveApplicationClassFor:el.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1147
87bb1815460b initial checkin
ca
parents:
diff changeset
  1148
        cls notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1149
            ctr := applications at:cls ifAbsent:0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1150
            applications at:cls put:(ctr + 1).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1151
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1152
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1153
    item recursiveDo:addBlock.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1154
    addBlock value:item.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1155
87bb1815460b initial checkin
ca
parents:
diff changeset
  1156
    applications isEmpty ifTrue:[^ nil ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1157
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1158
87bb1815460b initial checkin
ca
parents:
diff changeset
  1159
    applications keysAndValuesDo:[:cls :ctr|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1160
       list add:(MenuDesc title:(cls name)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1161
                          value:(ctr printString)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1162
                         action:[self doSelectNextOfApplicationClass:cls startingIn:item]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1163
                 ).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1164
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1165
87bb1815460b initial checkin
ca
parents:
diff changeset
  1166
    menu := MenuDesc buildFromList:list onGC:aMenu.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1167
    menu do:[:el|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1168
        el hideMenuOnActivated:false
87bb1815460b initial checkin
ca
parents:
diff changeset
  1169
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1170
    ^ menu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1171
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1172
87bb1815460b initial checkin
ca
parents:
diff changeset
  1173
submenuComponents:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1174
    |widgets list total menu item|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1175
87bb1815460b initial checkin
ca
parents:
diff changeset
  1176
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1177
                                              ifFalse:[model rootItem].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1178
    item isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1179
87bb1815460b initial checkin
ca
parents:
diff changeset
  1180
    widgets := IdentityDictionary new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1181
    total   := 0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1182
87bb1815460b initial checkin
ca
parents:
diff changeset
  1183
    item recursiveDo:[:el| |cls ctr|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1184
        cls := el widget.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1185
87bb1815460b initial checkin
ca
parents:
diff changeset
  1186
        cls notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1187
            cls := cls class.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1188
            ctr := widgets at:cls ifAbsent:0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1189
            widgets at:cls put:(ctr + 1).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1190
            total := total + 1.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1191
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1192
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1193
    total == 0 ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1194
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1195
87bb1815460b initial checkin
ca
parents:
diff changeset
  1196
    widgets keysAndValuesDo:[:cls :ctr|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1197
        list add:(MenuDesc title:(cls name)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1198
                           value:(ctr printString)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1199
                          action:[self doSelectNextOfClass:cls startingIn:item]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1200
                 ).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1201
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1202
    list := list asOrderedCollection.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1203
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1204
    list add:(MenuDesc title:'Total' value:(total printString)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1205
    menu := MenuDesc buildFromList:list onGC:aMenu.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1206
    menu do:[:el|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1207
        el hideMenuOnActivated:false
87bb1815460b initial checkin
ca
parents:
diff changeset
  1208
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1209
    ^ menu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1210
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1211
87bb1815460b initial checkin
ca
parents:
diff changeset
  1212
submenuGeometry:aMenu
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1213
    "builds and returns the geometry submenu"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1214
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1215
    |view point inst list x y|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1216
87bb1815460b initial checkin
ca
parents:
diff changeset
  1217
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1218
    view isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1219
87bb1815460b initial checkin
ca
parents:
diff changeset
  1220
    list := OrderedCollection new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1221
87bb1815460b initial checkin
ca
parents:
diff changeset
  1222
    "/ origin
87bb1815460b initial checkin
ca
parents:
diff changeset
  1223
    point := view relativeOrigin.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1224
    point isNil ifTrue:[ point := view origin ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1225
87bb1815460b initial checkin
ca
parents:
diff changeset
  1226
    x := view left.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1227
    y := view top.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1228
87bb1815460b initial checkin
ca
parents:
diff changeset
  1229
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1230
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1231
87bb1815460b initial checkin
ca
parents:
diff changeset
  1232
    list add:(MenuDesc title:'origin' value:inst).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1233
87bb1815460b initial checkin
ca
parents:
diff changeset
  1234
    "/ corner
87bb1815460b initial checkin
ca
parents:
diff changeset
  1235
    point := view relativeCorner.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1236
    point isNil ifTrue:[ point := view corner ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1237
87bb1815460b initial checkin
ca
parents:
diff changeset
  1238
    x := view right.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1239
    y := view bottom.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1240
87bb1815460b initial checkin
ca
parents:
diff changeset
  1241
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1242
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1243
87bb1815460b initial checkin
ca
parents:
diff changeset
  1244
    list add:(MenuDesc title:'corner' value:inst).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1245
87bb1815460b initial checkin
ca
parents:
diff changeset
  1246
    "/ extent
87bb1815460b initial checkin
ca
parents:
diff changeset
  1247
    (point := view relativeExtent) isNil ifTrue:[point := view extent].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1248
    list add:(MenuDesc title:'extent' value:point).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1249
87bb1815460b initial checkin
ca
parents:
diff changeset
  1250
    "/ preferred extent
87bb1815460b initial checkin
ca
parents:
diff changeset
  1251
    list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1252
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1253
87bb1815460b initial checkin
ca
parents:
diff changeset
  1254
    "/ view insets
87bb1815460b initial checkin
ca
parents:
diff changeset
  1255
    inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1256
                                         with:(view rightInset)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1257
                                         with:(view topInset)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1258
                                         with:(view bottomInset).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1259
87bb1815460b initial checkin
ca
parents:
diff changeset
  1260
    list add:(MenuDesc title:'insets'      value:inst).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1261
    list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1262
    list add:(MenuDesc title:'level'       value:(view level)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1263
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1264
87bb1815460b initial checkin
ca
parents:
diff changeset
  1265
    (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1266
    list add:(MenuDesc title:'layout' value:inst).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1267
87bb1815460b initial checkin
ca
parents:
diff changeset
  1268
    (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1269
    list add:(MenuDesc title:'transformation' value:inst).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1270
87bb1815460b initial checkin
ca
parents:
diff changeset
  1271
  ^ MenuDesc buildFromList:list onGC:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1272
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1273
87bb1815460b initial checkin
ca
parents:
diff changeset
  1274
submenuInspector:aMenu
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1275
    "builds and returns the inspector submenu"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1276
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1277
    |view list n names label value|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1278
87bb1815460b initial checkin
ca
parents:
diff changeset
  1279
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1280
    view isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1281
87bb1815460b initial checkin
ca
parents:
diff changeset
  1282
    n := view class instSize.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1283
    n > 0 ifFalse:[^ nil ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1284
87bb1815460b initial checkin
ca
parents:
diff changeset
  1285
    list  := OrderedCollection new:n.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1286
    names := view class allInstVarNames.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1287
87bb1815460b initial checkin
ca
parents:
diff changeset
  1288
    1 to:n do:[:i| |action|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1289
        label := (names at:i) printString.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1290
        value := view instVarAt:i.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1291
        value isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1292
            value  := '------'.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1293
            action := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1294
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1295
            value  := value displayString contractAtEndTo:40.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1296
            action := [(view instVarAt:i) inspect].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1297
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1298
        list add:(MenuDesc title:label value:value action:action).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1299
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1300
87bb1815460b initial checkin
ca
parents:
diff changeset
  1301
    ^ MenuDesc buildFromList:list onGC:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1302
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1303
87bb1815460b initial checkin
ca
parents:
diff changeset
  1304
submenuInterface:aMenu
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1305
    "builds and returns the interface submenu"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1306
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1307
    |view label inst value list|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1308
87bb1815460b initial checkin
ca
parents:
diff changeset
  1309
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1310
    view isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1311
87bb1815460b initial checkin
ca
parents:
diff changeset
  1312
    list := OrderedCollection new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1313
87bb1815460b initial checkin
ca
parents:
diff changeset
  1314
    inst  := view controller.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1315
    value := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1316
87bb1815460b initial checkin
ca
parents:
diff changeset
  1317
    inst isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1318
        label := nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1319
    ] ifFalse:[
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1320
        inst == view ifTrue:[ 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1321
            label := '== view itself' 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1322
        ] ifFalse:[ 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1323
            label := inst displayString.
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1324
            value := [view controller inspect].
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1325
        ].
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1326
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1327
    list add:(MenuDesc title:'controller' value:label action:value).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1328
87bb1815460b initial checkin
ca
parents:
diff changeset
  1329
    inst := view delegate.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1330
    inst notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1331
        list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1332
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1333
87bb1815460b initial checkin
ca
parents:
diff changeset
  1334
    inst := view application.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1335
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1336
    inst notNil ifTrue:[ 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1337
        |topAppl|
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1338
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1339
        list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1340
87bb1815460b initial checkin
ca
parents:
diff changeset
  1341
        topAppl := inst topApplication.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1342
87bb1815460b initial checkin
ca
parents:
diff changeset
  1343
        (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1344
            list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1345
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1346
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1347
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1348
87bb1815460b initial checkin
ca
parents:
diff changeset
  1349
    (view respondsTo:#'model:') ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1350
        inst := model.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1351
87bb1815460b initial checkin
ca
parents:
diff changeset
  1352
        inst isNil ifTrue:[ label := value := nil ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1353
                  ifFalse:[ label := inst displayString.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1354
                            value := [ view model inspect ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1355
                          ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1356
87bb1815460b initial checkin
ca
parents:
diff changeset
  1357
        list add:(MenuDesc title:'model' value:label action:value).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1358
87bb1815460b initial checkin
ca
parents:
diff changeset
  1359
        (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1360
            view modelInterface keysAndValuesDo:[:key : val|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1361
                val isNil ifTrue:[ label := nil ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1362
                         ifFalse:[ label := val displayString ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1363
87bb1815460b initial checkin
ca
parents:
diff changeset
  1364
                list add:(MenuDesc title:('      - ', key) value:label ).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1365
            ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1366
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1367
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1368
87bb1815460b initial checkin
ca
parents:
diff changeset
  1369
    (view respondsTo:#enableChannel) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1370
        inst := view enableChannel.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1371
87bb1815460b initial checkin
ca
parents:
diff changeset
  1372
        inst isNil ifTrue:[ label := value := nil ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1373
                  ifFalse:[ label := inst displayString.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1374
                            value := [ view enableChannel inspect ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1375
                          ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1376
87bb1815460b initial checkin
ca
parents:
diff changeset
  1377
        list add:(MenuDesc title:'enableChannel' value:label action:value).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1378
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1379
87bb1815460b initial checkin
ca
parents:
diff changeset
  1380
    list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1381
87bb1815460b initial checkin
ca
parents:
diff changeset
  1382
    (view respondsTo:#listHolder) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1383
        inst := view listHolder.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1384
87bb1815460b initial checkin
ca
parents:
diff changeset
  1385
        inst isNil ifTrue:[ label := value := nil ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1386
                  ifFalse:[ label := inst class printString.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1387
                            value := [ view listHolder inspect ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1388
                          ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1389
        list add:(MenuDesc title:'listHolder' value:label action:value).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1390
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1391
87bb1815460b initial checkin
ca
parents:
diff changeset
  1392
    (view respondsTo:#list) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1393
        inst := view list.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1394
87bb1815460b initial checkin
ca
parents:
diff changeset
  1395
        inst isNil ifTrue:[ label := value := nil ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1396
                  ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1397
                            value := [ view list inspect ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1398
                          ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1399
87bb1815460b initial checkin
ca
parents:
diff changeset
  1400
        list add:(MenuDesc title:'list' value:label action:value).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1401
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1402
87bb1815460b initial checkin
ca
parents:
diff changeset
  1403
    list last isSeparator ifTrue:[ list removeLast ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1404
  ^ MenuDesc buildFromList:list onGC:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1405
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1406
87bb1815460b initial checkin
ca
parents:
diff changeset
  1407
submenuVisibility:aMenu
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1408
    "builds and returns the geometry submenu"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1409
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1410
    |view list value|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1411
87bb1815460b initial checkin
ca
parents:
diff changeset
  1412
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1413
    view isNil ifTrue:[^ nil].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1414
87bb1815460b initial checkin
ca
parents:
diff changeset
  1415
    list := OrderedCollection new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1416
87bb1815460b initial checkin
ca
parents:
diff changeset
  1417
    list add:(MenuDesc title:'device'     value:(view device printString)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1418
    list add:(MenuDesc title:'drawableId' value:(view id)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1419
    list add:(MenuDesc title:'gcId'       value:(view gcId)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1420
87bb1815460b initial checkin
ca
parents:
diff changeset
  1421
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1422
87bb1815460b initial checkin
ca
parents:
diff changeset
  1423
    list add:(MenuDesc title:'shown'    value:(view shown)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1424
    list add:(MenuDesc title:'realized' value:(view realized)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1425
87bb1815460b initial checkin
ca
parents:
diff changeset
  1426
    list add:(MenuDesc separator).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1427
87bb1815460b initial checkin
ca
parents:
diff changeset
  1428
    list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1429
87bb1815460b initial checkin
ca
parents:
diff changeset
  1430
    (value := view visibilityChannel) isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1431
        list add:(MenuDesc title:'visibilityChannel' value:'------').
87bb1815460b initial checkin
ca
parents:
diff changeset
  1432
    ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1433
        list add:(MenuDesc title:'visibilityChannel'
87bb1815460b initial checkin
ca
parents:
diff changeset
  1434
                           value:(value displayString)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1435
                          action:[view visibilityChannel inspect]).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1436
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1437
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1438
    ^ MenuDesc buildFromList:list onGC:aMenu
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1439
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1440
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1441
!ViewTreeInspectorApplication methodsFor:'private'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1442
87bb1815460b initial checkin
ca
parents:
diff changeset
  1443
selectFocusView
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1444
    |rootView focusView|
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1445
87bb1815460b initial checkin
ca
parents:
diff changeset
  1446
    rootView := model rootView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1447
87bb1815460b initial checkin
ca
parents:
diff changeset
  1448
    (rootView notNil and:[rootView shown]) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1449
        focusView := rootView windowGroup focusView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1450
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1451
    focusView isNil ifTrue:[^ self ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1452
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1453
    self selectView:focusView
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1454
!
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1455
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1456
selectView:aView
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1457
    |currentItem viewItem|
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1458
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1459
    currentItem := model selectedItem.
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1460
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1461
    (currentItem notNil and:[currentItem widget == aView]) ifTrue:[
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1462
        ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
  1463
    ].
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1464
    viewItem := model listOfItems recursiveDetect:[:el| el widget == aView ].
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1465
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1466
    viewItem notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1467
        model selectItem:viewItem.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1468
    ].        
87bb1815460b initial checkin
ca
parents:
diff changeset
  1469
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1470
87bb1815460b initial checkin
ca
parents:
diff changeset
  1471
setRootItem:aRootItemOrNil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1472
    |theProcess|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1473
87bb1815460b initial checkin
ca
parents:
diff changeset
  1474
    aRootItemOrNil isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1475
        process := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1476
    ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1477
        "/ expand tree to level 3
87bb1815460b initial checkin
ca
parents:
diff changeset
  1478
        aRootItemOrNil do:[:aRootChild|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1479
            aRootChild do:[:aSubChild| aSubChild expand ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1480
            aRootChild expand.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1481
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1482
        aRootItemOrNil expand.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1483
87bb1815460b initial checkin
ca
parents:
diff changeset
  1484
        process isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1485
            theProcess := process :=
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1486
                Process for:[   |update testModeChannel|
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1487
87bb1815460b initial checkin
ca
parents:
diff changeset
  1488
                                update := false.
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1489
                                testModeChannel := model testModeChannel.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1490
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1491
                                [process == theProcess] whileTrue:[
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1492
                                    Delay waitForSeconds:0.5.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1493
87bb1815460b initial checkin
ca
parents:
diff changeset
  1494
                                    (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1495
                                        (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1496
                                            self selectFocusView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1497
                                        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1498
                                        update ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1499
                                            self updateShownStatus.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1500
                                        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1501
                                        update := update not.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1502
                                    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1503
                                ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1504
87bb1815460b initial checkin
ca
parents:
diff changeset
  1505
                             ] priority:8.
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1506
            theProcess name:'ViewTreeInspector - Follow Focus'.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1507
            theProcess resume.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1508
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1509
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1510
    model rootItem:aRootItemOrNil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1511
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1512
87bb1815460b initial checkin
ca
parents:
diff changeset
  1513
updateShownStatus
87bb1815460b initial checkin
ca
parents:
diff changeset
  1514
    |rootItem min max visState listIdx visY0 visY1 height damage|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1515
87bb1815460b initial checkin
ca
parents:
diff changeset
  1516
    rootItem := model rootItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1517
    (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1518
87bb1815460b initial checkin
ca
parents:
diff changeset
  1519
    max := 0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1520
    min := 9999999.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1521
87bb1815460b initial checkin
ca
parents:
diff changeset
  1522
    rootItem recursiveEachVisibleItemDo:[:anItem|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1523
        visState := (anItem widget shown).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1524
87bb1815460b initial checkin
ca
parents:
diff changeset
  1525
        visState ~~ anItem isDrawnShown ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1526
            anItem isDrawnShown:visState.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1527
            listIdx := treeView identityIndexOf:anItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1528
87bb1815460b initial checkin
ca
parents:
diff changeset
  1529
            listIdx > 0 ifTrue:[    
87bb1815460b initial checkin
ca
parents:
diff changeset
  1530
                max := max max:listIdx.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1531
                min := min min:listIdx.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1532
            ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1533
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1534
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1535
    max < min ifTrue:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1536
    max := max + 1.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1537
87bb1815460b initial checkin
ca
parents:
diff changeset
  1538
    visY0  := (treeView yVisibleOfLine:min) max:0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1539
    visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1540
    height := visY1 - visY0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1541
    
87bb1815460b initial checkin
ca
parents:
diff changeset
  1542
    height > 2 ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1543
        treeView shown ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1544
            damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1545
            treeView invalidateDeviceRectangle:damage repairNow:false.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1546
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1547
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1548
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1549
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1550
!ViewTreeInspectorApplication methodsFor:'selection'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1551
87bb1815460b initial checkin
ca
parents:
diff changeset
  1552
selectedView
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1553
    "answer the selected view or nil"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1554
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1555
    |item|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1556
87bb1815460b initial checkin
ca
parents:
diff changeset
  1557
    item := model selectedItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1558
    item notNil ifTrue:[ ^ item widget ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1559
  ^ nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1560
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1561
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1562
!ViewTreeInspectorApplication methodsFor:'testing'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1563
87bb1815460b initial checkin
ca
parents:
diff changeset
  1564
resolveApplicationClassFor:aTreeItem
87bb1815460b initial checkin
ca
parents:
diff changeset
  1565
    aTreeItem isApplicationClass ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1566
       ^ aTreeItem applicationClass
87bb1815460b initial checkin
ca
parents:
diff changeset
  1567
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1568
    ^ nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1569
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1570
87bb1815460b initial checkin
ca
parents:
diff changeset
  1571
selectedComponentHasChildren
87bb1815460b initial checkin
ca
parents:
diff changeset
  1572
    |item|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1573
87bb1815460b initial checkin
ca
parents:
diff changeset
  1574
    item := model selectedItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1575
    ^ (item notNil and:[item hasChildren])
87bb1815460b initial checkin
ca
parents:
diff changeset
  1576
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1577
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1578
!ViewTreeInspectorApplication methodsFor:'user operations'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1579
87bb1815460b initial checkin
ca
parents:
diff changeset
  1580
doBrowse:what
87bb1815460b initial checkin
ca
parents:
diff changeset
  1581
    "open browser on:
87bb1815460b initial checkin
ca
parents:
diff changeset
  1582
        #view           browse class
87bb1815460b initial checkin
ca
parents:
diff changeset
  1583
        #model          browse model class
87bb1815460b initial checkin
ca
parents:
diff changeset
  1584
        #application    browse application class
87bb1815460b initial checkin
ca
parents:
diff changeset
  1585
        #controller     browse controller class
87bb1815460b initial checkin
ca
parents:
diff changeset
  1586
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
  1587
    |view inst|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1588
87bb1815460b initial checkin
ca
parents:
diff changeset
  1589
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1590
    view isNil ifTrue:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1591
87bb1815460b initial checkin
ca
parents:
diff changeset
  1592
             what == #view        ifTrue:[ inst := view ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1593
    ifFalse:[what == #model       ifTrue:[ inst := view model ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1594
    ifFalse:[what == #application ifTrue:[ inst := view application ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1595
    ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1596
    ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1597
        ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
  1598
    ]]]].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1599
87bb1815460b initial checkin
ca
parents:
diff changeset
  1600
    inst notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1601
        inst class browserClass openInClass:(inst class) selector:nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1602
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1603
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1604
87bb1815460b initial checkin
ca
parents:
diff changeset
  1605
doDestroy
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1606
    "destroy the current selected view"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1607
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1608
    |item parent|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1609
87bb1815460b initial checkin
ca
parents:
diff changeset
  1610
    item := model selectedItem.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1611
    item isNil ifTrue:[ ^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1612
87bb1815460b initial checkin
ca
parents:
diff changeset
  1613
    parent := item parent.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1614
87bb1815460b initial checkin
ca
parents:
diff changeset
  1615
    parent isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1616
        "/ the root
87bb1815460b initial checkin
ca
parents:
diff changeset
  1617
        model withSelectionHiddenDo:[item deleteAll].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1618
      ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
  1619
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1620
87bb1815460b initial checkin
ca
parents:
diff changeset
  1621
    model withSelectionHiddenDo:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1622
        |idx nsel|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1623
87bb1815460b initial checkin
ca
parents:
diff changeset
  1624
        idx := parent identityIndexOf:item.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1625
87bb1815460b initial checkin
ca
parents:
diff changeset
  1626
        idx == parent size ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1627
            nsel := parent at:(idx - 1) ifAbsent:parent
87bb1815460b initial checkin
ca
parents:
diff changeset
  1628
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1629
            nsel := parent at:(idx + 1)
87bb1815460b initial checkin
ca
parents:
diff changeset
  1630
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1631
        model setValue:nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1632
        item delete.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1633
87bb1815460b initial checkin
ca
parents:
diff changeset
  1634
        parent isLayoutContainer ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1635
            parent widget sizeChanged:nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1636
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1637
        model value:nsel.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1638
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1639
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1640
87bb1815460b initial checkin
ca
parents:
diff changeset
  1641
doFlash
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1642
    "flash the selected view"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1643
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1644
    |view|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1645
87bb1815460b initial checkin
ca
parents:
diff changeset
  1646
    view := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1647
    view isNil ifTrue:[ ^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1648
87bb1815460b initial checkin
ca
parents:
diff changeset
  1649
    view shown ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1650
        model withSelectionHiddenDo:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1651
            view perform:#flash ifNotUnderstood:nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1652
        ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1653
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1654
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1655
87bb1815460b initial checkin
ca
parents:
diff changeset
  1656
doInspect:what
87bb1815460b initial checkin
ca
parents:
diff changeset
  1657
    "open inspector on:
87bb1815460b initial checkin
ca
parents:
diff changeset
  1658
        #view           inspect class
87bb1815460b initial checkin
ca
parents:
diff changeset
  1659
        #group          inspect windowGroup
87bb1815460b initial checkin
ca
parents:
diff changeset
  1660
        #model          inspect model
87bb1815460b initial checkin
ca
parents:
diff changeset
  1661
        #application    inspect application
87bb1815460b initial checkin
ca
parents:
diff changeset
  1662
        #controller     inspect controller
87bb1815460b initial checkin
ca
parents:
diff changeset
  1663
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
  1664
    |inst|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1665
87bb1815460b initial checkin
ca
parents:
diff changeset
  1666
    inst := self selectedView.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1667
    inst isNil ifTrue:[^ self].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1668
87bb1815460b initial checkin
ca
parents:
diff changeset
  1669
             what == #group       ifTrue:[ inst := inst windowGroup ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1670
    ifFalse:[what == #model       ifTrue:[ inst := inst model ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1671
    ifFalse:[what == #application ifTrue:[ inst := inst application ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1672
    ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1673
87bb1815460b initial checkin
ca
parents:
diff changeset
  1674
    inst notNil ifTrue:[ inst inspect ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1675
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1676
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1677
doPickView
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1678
    "pick a window's topView"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1679
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1680
    |screen clickedView topWindow cursor|
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1681
87bb1815460b initial checkin
ca
parents:
diff changeset
  1682
    self doUnpick.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1683
2759
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
  1684
    cursor := Cursor fromImage:(self class crossHairIcon).
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
  1685
Claus Gittinger <cg@exept.de>
parents: 2758
diff changeset
  1686
    screen := Screen current.
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1687
    clickedView := screen viewFromPoint:(screen pointFromUserShowing:cursor).
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1688
    clickedView isNil ifTrue:[^ self].
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1689
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1690
    topWindow := clickedView topView.
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1691
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1692
    (    topWindow == Screen current rootView
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1693
     or:[topWindow == self window topView]
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1694
    ) ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1695
        ^ self
87bb1815460b initial checkin
ca
parents:
diff changeset
  1696
    ].
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1697
    self setRootItem:(ViewTreeItem buildViewsFrom:topWindow).
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  1698
    self selectView:clickedView.
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1699
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1700
87bb1815460b initial checkin
ca
parents:
diff changeset
  1701
doSelectNextOfApplicationClass:aClass startingIn:anItem
87bb1815460b initial checkin
ca
parents:
diff changeset
  1702
    |startItem firstFound searchNext|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1703
87bb1815460b initial checkin
ca
parents:
diff changeset
  1704
    startItem  := model last.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1705
    searchNext := startItem notNil.        
87bb1815460b initial checkin
ca
parents:
diff changeset
  1706
    firstFound := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1707
87bb1815460b initial checkin
ca
parents:
diff changeset
  1708
    anItem recursiveDo:[:el|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1709
        el == startItem ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1710
            searchNext := false
87bb1815460b initial checkin
ca
parents:
diff changeset
  1711
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1712
            (self resolveApplicationClassFor:el) == aClass ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1713
                searchNext ifFalse:[^ model selectItem:el].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1714
87bb1815460b initial checkin
ca
parents:
diff changeset
  1715
                firstFound isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1716
                    firstFound := el
87bb1815460b initial checkin
ca
parents:
diff changeset
  1717
                ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1718
            ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1719
        ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1720
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1721
    firstFound notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1722
        self window beep.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1723
        model selectItem:firstFound
87bb1815460b initial checkin
ca
parents:
diff changeset
  1724
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1725
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1726
87bb1815460b initial checkin
ca
parents:
diff changeset
  1727
doSelectNextOfClass:aClass startingIn:anItem
87bb1815460b initial checkin
ca
parents:
diff changeset
  1728
    |startItem firstFound searchNext|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1729
87bb1815460b initial checkin
ca
parents:
diff changeset
  1730
    startItem  := model last.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1731
    searchNext := startItem notNil.        
87bb1815460b initial checkin
ca
parents:
diff changeset
  1732
    firstFound := nil.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1733
87bb1815460b initial checkin
ca
parents:
diff changeset
  1734
    anItem recursiveDo:[:el|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1735
        el == startItem ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1736
            searchNext := false
87bb1815460b initial checkin
ca
parents:
diff changeset
  1737
        ] ifFalse:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1738
            el widget class == aClass ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1739
                searchNext ifFalse:[^ model selectItem:el].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1740
87bb1815460b initial checkin
ca
parents:
diff changeset
  1741
                firstFound isNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1742
                    firstFound := el
87bb1815460b initial checkin
ca
parents:
diff changeset
  1743
                ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1744
            ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1745
        ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1746
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1747
    firstFound notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1748
        self window beep.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1749
        model selectItem:firstFound
87bb1815460b initial checkin
ca
parents:
diff changeset
  1750
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1751
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1752
87bb1815460b initial checkin
ca
parents:
diff changeset
  1753
doUnpick
2455
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1754
    "release current picked window and contained subwindows"
93aaf62a6b95 remove colors from window spec & rework
ca
parents: 2454
diff changeset
  1755
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1756
    self setRootItem:nil.
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1757
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1758
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1759
openDocumentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1760
    HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1761
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1762
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1763
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1764
87bb1815460b initial checkin
ca
parents:
diff changeset
  1765
buildFromList:aList onGC:aMenu
87bb1815460b initial checkin
ca
parents:
diff changeset
  1766
    |tabSpec menu w menuPanel|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1767
87bb1815460b initial checkin
ca
parents:
diff changeset
  1768
    w := 0.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1769
    aList do:[:el| w := w max:(el widthOn:aMenu) ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1770
87bb1815460b initial checkin
ca
parents:
diff changeset
  1771
    tabSpec := TabulatorSpecification new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1772
    tabSpec unit:#pixel.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1773
    tabSpec positions:#(0     1.5 ).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1774
    tabSpec align:#(#left #left).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1775
87bb1815460b initial checkin
ca
parents:
diff changeset
  1776
    w := w + 15.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1777
    tabSpec positions:(Array with:0 with:w).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1778
87bb1815460b initial checkin
ca
parents:
diff changeset
  1779
    menu := Menu new.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1780
87bb1815460b initial checkin
ca
parents:
diff changeset
  1781
    aList do:[:el|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1782
        menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
87bb1815460b initial checkin
ca
parents:
diff changeset
  1783
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1784
    menuPanel := MenuPanel menu:menu.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1785
    ^ menuPanel
87bb1815460b initial checkin
ca
parents:
diff changeset
  1786
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1787
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1788
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1789
87bb1815460b initial checkin
ca
parents:
diff changeset
  1790
separator
87bb1815460b initial checkin
ca
parents:
diff changeset
  1791
    ^ self new
87bb1815460b initial checkin
ca
parents:
diff changeset
  1792
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1793
87bb1815460b initial checkin
ca
parents:
diff changeset
  1794
title:aTitle value:aValue
87bb1815460b initial checkin
ca
parents:
diff changeset
  1795
    ^ self title:aTitle value:aValue action:nil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1796
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1797
87bb1815460b initial checkin
ca
parents:
diff changeset
  1798
title:aTitle value:aValue action:anAction
87bb1815460b initial checkin
ca
parents:
diff changeset
  1799
    ^ self new title:aTitle value:aValue action:anAction
87bb1815460b initial checkin
ca
parents:
diff changeset
  1800
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1801
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1802
!ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1803
87bb1815460b initial checkin
ca
parents:
diff changeset
  1804
title
87bb1815460b initial checkin
ca
parents:
diff changeset
  1805
    ^ title
87bb1815460b initial checkin
ca
parents:
diff changeset
  1806
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1807
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1808
!ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1809
87bb1815460b initial checkin
ca
parents:
diff changeset
  1810
asMenuItemWithTabulatorSpecification:aTabSpec
87bb1815460b initial checkin
ca
parents:
diff changeset
  1811
    |array|
87bb1815460b initial checkin
ca
parents:
diff changeset
  1812
87bb1815460b initial checkin
ca
parents:
diff changeset
  1813
    title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
87bb1815460b initial checkin
ca
parents:
diff changeset
  1814
87bb1815460b initial checkin
ca
parents:
diff changeset
  1815
    array := Array with:(title, ':') with:'------'.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1816
87bb1815460b initial checkin
ca
parents:
diff changeset
  1817
    value notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1818
        array at:2 put:(value printString, ' ')
87bb1815460b initial checkin
ca
parents:
diff changeset
  1819
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1820
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1821
   ^ MenuItem 
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1822
        label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1823
        value:action
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1824
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1825
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1826
!ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1827
87bb1815460b initial checkin
ca
parents:
diff changeset
  1828
title:aTitle value:aValue action:anAction
87bb1815460b initial checkin
ca
parents:
diff changeset
  1829
    "test for separator
87bb1815460b initial checkin
ca
parents:
diff changeset
  1830
    "
87bb1815460b initial checkin
ca
parents:
diff changeset
  1831
    title  := aTitle withoutSeparators.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1832
    action := anAction.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1833
87bb1815460b initial checkin
ca
parents:
diff changeset
  1834
    aValue notNil ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1835
        value := aValue printString.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1836
87bb1815460b initial checkin
ca
parents:
diff changeset
  1837
        value size > 70 ifTrue:[
87bb1815460b initial checkin
ca
parents:
diff changeset
  1838
            value := value copyFrom:1 to:70.
87bb1815460b initial checkin
ca
parents:
diff changeset
  1839
            value := value, '...'
87bb1815460b initial checkin
ca
parents:
diff changeset
  1840
        ]
87bb1815460b initial checkin
ca
parents:
diff changeset
  1841
    ].
87bb1815460b initial checkin
ca
parents:
diff changeset
  1842
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1843
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1844
!ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1845
87bb1815460b initial checkin
ca
parents:
diff changeset
  1846
isSeparator
87bb1815460b initial checkin
ca
parents:
diff changeset
  1847
    ^ title isNil
87bb1815460b initial checkin
ca
parents:
diff changeset
  1848
!
87bb1815460b initial checkin
ca
parents:
diff changeset
  1849
87bb1815460b initial checkin
ca
parents:
diff changeset
  1850
widthOn:aGC
87bb1815460b initial checkin
ca
parents:
diff changeset
  1851
    title isNil ifTrue:[^ 5].  "/ separator
2758
c61fe917957a comment/format in:8 methods
Claus Gittinger <cg@exept.de>
parents: 2757
diff changeset
  1852
    ^ title widthOn:aGC
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1853
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1854
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1855
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1856
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1857
buildViewsFrom:aView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1858
    "build the items starting from a source view;
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1859
     returns the anhor.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1860
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1861
    |item subViews subItems|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1862
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1863
    aView isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1864
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1865
    item     := self forView:aView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1866
    subViews := aView subViews.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1867
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1868
    subViews notEmptyOrNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1869
        subItems := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1870
        subViews do:[:aSubView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1871
            subItems add:(self buildViewsFrom:aSubView).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1872
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1873
        item children:subItems.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1874
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1875
    ^ item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1876
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1877
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1878
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1879
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1880
documentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1881
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1882
    ViewTreeItems represants a pickable object within a ViewTreeModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1883
    The class is used to build up the hierarchical tree.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1884
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1885
    [Instance variables:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1886
        widget        <View>            the widget represented by the item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1887
        spec          <UISpecification> the UISpecification or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1888
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1889
    [Class variables:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1890
        HandleExtent  <Point>           keeps the extent of a handle
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1891
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1892
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1893
    [author:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1894
        Claus Atzkern
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1895
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1896
    [see also:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1897
        HierarchicalItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1898
        ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1899
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1900
!
2177
87bb1815460b initial checkin
ca
parents:
diff changeset
  1901
87bb1815460b initial checkin
ca
parents:
diff changeset
  1902
version
87bb1815460b initial checkin
ca
parents:
diff changeset
  1903
    ^ '$Header$'
87bb1815460b initial checkin
ca
parents:
diff changeset
  1904
! !
87bb1815460b initial checkin
ca
parents:
diff changeset
  1905
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1906
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1907
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1908
initialize
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1909
    "set the extent of the Handle
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1910
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1911
    HandleExtent := 6@6.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1912
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1913
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1914
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1915
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1916
forView:aView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1917
    |item|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1918
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1919
    item := self basicNew initialize.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1920
    item forView:aView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1921
  ^ item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1922
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1923
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1924
new
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1925
    self error:'not allowed'.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1926
  ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1927
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1928
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1929
on:aView withSpec:aSpec
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1930
    |item|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1931
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1932
    item := self basicNew initialize.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1933
    item on:aView withSpec:aSpec.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1934
  ^ item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1935
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1936
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1937
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1938
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1939
applicationClass
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1940
    |appl|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1941
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1942
    widget notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1943
        appl := widget application.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1944
        appl notNil ifTrue:[^ appl class ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1945
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1946
    ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1947
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1948
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1949
isDrawnShown
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1950
    "returns true if the last display operations was done during the widget was shown
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1951
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1952
    ^ isDrawnShown
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1953
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1954
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1955
isDrawnShown:aBoolean
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1956
    isDrawnShown := aBoolean.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1957
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1958
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1959
rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1960
    "returns the widget assigned to the root or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1961
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1962
    ^ parent rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1963
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1964
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1965
specClass
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1966
    "returns the spec-class assigned to the item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1967
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1968
    ^ widget specClass
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1969
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1970
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1971
treeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1972
    "returns the assigned treeModel, an instance of ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1973
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1974
    ^ parent treeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1975
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1976
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1977
widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1978
    "returns the widget assigned to the item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1979
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1980
    ^ widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1981
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1982
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1983
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1984
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1985
boundsRelativeToRoot
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1986
    "returns the bounds relative to the root widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1987
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1988
    ^ self originRelativeToRoot extent:(widget extent)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1989
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1990
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1991
cornerRelativeToRoot
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1992
    "returns the corner relative to the root widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1993
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1994
    ^ self originRelativeToRoot + (widget extent)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1995
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1996
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1997
extent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1998
    "returns the extent of the widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  1999
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2000
    ^ widget extent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2001
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2002
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2003
layoutType
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2004
    "returns the type of layout assigned to the wiget; nil if the
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2005
     superView cannot resize its sub widgets
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2006
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2007
    |layout specClass superView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2008
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2009
    (superView := widget superView) isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2010
        ^ #Extent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2011
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2012
        
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2013
    specClass := superView specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2014
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2015
    (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2016
        ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2017
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2018
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2019
    (layout := widget geometryLayout) isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2020
        ^ #Extent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2021
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2022
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2023
    layout isLayout ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2024
        layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2025
        layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2026
        layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2027
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2028
        layout isRectangle          ifTrue:[ ^ #Rectangle ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2029
        layout isPoint              ifTrue:[ ^ #Point ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2030
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2031
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2032
    Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2033
  ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2034
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2035
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2036
originRelativeToRoot
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2037
    "returns the origin relative to the root widget
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2038
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2039
    ^ widget originRelativeTo:(self rootView)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2040
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2041
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2042
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2043
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2044
children
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2045
    "redefined: optimize
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2046
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2047
    ^ children
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2048
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2049
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2050
hasChildren
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2051
    |subViews list item|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2052
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2053
    children size ~~ 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2054
        ^ true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2055
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2056
    isExpanded := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2057
    subViews   := widget subViews.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2058
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2059
    subViews size == 0 ifTrue:[^ false].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2060
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2061
    list := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2062
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2063
    subViews do:[:aSubView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2064
        item := self class buildViewsFrom:aSubView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2065
        item parent:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2066
        list add:item.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2067
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2068
    children := list.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2069
    ^ true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2070
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2071
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2072
size
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2073
    "redefined: returns list of children
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2074
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2075
    ^ children size
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2076
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2077
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2078
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2079
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2080
additionalLabelForItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2081
    "answer an additional item for an Item or nil"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2082
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2083
    parent notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2084
        ^ parent additionalLabelForItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2085
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2086
    ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2087
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2088
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2089
displayIcon:anIcon atX:x y:y on:aGC
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2090
    |x0 y0 y1 w|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2091
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2092
    super displayIcon:anIcon atX:x y:y on:aGC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2093
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2094
    self exists ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2095
        aGC paint:(Color red).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2096
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2097
        y0 := y + 1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2098
        y1 := y + anIcon height - 2.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2099
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2100
        x0 := x - 1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2101
        w  := anIcon width.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2102
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2103
        2 timesRepeat:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2104
            aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2105
            aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2106
            x0 := x0 + 1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2107
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2108
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2109
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2110
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2111
displayOn:aGC x:x y:y h:h
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2112
    |labelHeight additionalName label isValidAndShown|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2113
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2114
    label := self label.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2115
    label isEmptyOrNil ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2116
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2117
    widget id isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2118
        isDrawnShown := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2119
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2120
        self exists ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2121
            xOffsetAdditionalName := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2122
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2123
        isValidAndShown := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2124
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2125
        isValidAndShown := widget shown.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2126
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2127
    isValidAndShown ifFalse:[
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  2128
        label := Text string:label emphasis:#italic.
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  2129
        label colorizeAllWith:Color grey.
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2130
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2131
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2132
    labelHeight := self heightOn:aGC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2133
    self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2134
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2135
    xOffsetAdditionalName notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2136
        additionalName := self additionalLabelForItem:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2137
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2138
        additionalName notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2139
            self displayLabel:additionalName
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2140
                            h:labelHeight on:aGC
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2141
                            x:(x + xOffsetAdditionalName)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2142
                            y:y
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2143
                            h:h.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2144
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2145
            xOffsetAdditionalName := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2146
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2147
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2148
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2149
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2150
recursiveAdditionalNameBehaviourChanged
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2151
    width := xOffsetAdditionalName := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2152
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2153
    children notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2154
        children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2155
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2156
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2157
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2158
widthOn:aGC
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2159
    "return the width of the receiver, if it is to be displayed on aGC
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2160
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2161
    |additionalName|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2162
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2163
    width isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2164
        width := self widthOf:(self label) on:aGC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2165
        width := width + 2.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2166
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2167
        additionalName := self additionalLabelForItem:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2168
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2169
        additionalName notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2170
            xOffsetAdditionalName := width + 10.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2171
            width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2172
            width := width + 2.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2173
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2174
            xOffsetAdditionalName := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2175
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2176
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2177
    ^ width
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2178
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2179
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2180
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2181
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2182
handlesDo:aTwoArgAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2183
    "evaluate the two arg block on each handle; the arguments to the block is
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2184
     the rectangle relative to the rootView and the handle type which is
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2185
     set to nil if not resizeable.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2186
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2187
     TYPES:     type    position( X - Y )
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2188
                -------------------------        
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2189
                #LT     Left   - Top
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2190
                #LC     Left   - Center
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2191
                #LB     Left   - Bottom
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2192
                #CT     Center - Top
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2193
                #CB     Center - Bottom
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2194
                #RT     Right  - Top
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2195
                #RC     Right  - Center
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2196
                #RB     Right  - Bottom
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2197
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2198
                nil     ** handle not pickable **
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2199
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2200
    |type relOrg relCrn maxExt rootView w h
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2201
     xL    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2202
     xC    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2203
     xR    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2204
     yT    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2205
     yC    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2206
     yB    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2207
    |
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2208
    rootView := self rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2209
    relOrg   := widget originRelativeTo:rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2210
    relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2211
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2212
    relOrg   := relOrg - (HandleExtent // 2).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2213
    relCrn   := relOrg + widget extent.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2214
    maxExt   := rootView extent - HandleExtent.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2215
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2216
    xL := relOrg x max:0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2217
    xR := relCrn x min:(maxExt x).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2218
    xC := xR + xL // 2.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2219
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2220
    yT := relOrg y max:0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2221
    yB := relCrn y min:(maxExt y).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2222
    yC := yB + yT // 2.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2223
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2224
    type := self layoutType.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2225
    w   := HandleExtent x.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2226
    h   := HandleExtent y.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2227
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2228
    (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2229
        aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2230
        aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2231
        aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2232
        aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2233
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2234
        aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2235
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2236
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2237
      ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2238
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2239
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2240
    aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2241
    aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2242
    aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2243
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2244
    type == #Extent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2245
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2246
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2247
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2248
      ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2249
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2250
    aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2251
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2252
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2253
recursiveEachVisibleItemDo:anOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2254
    "recursive evaluate the block on each child which is visible
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2255
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2256
    (isExpanded and:[children size > 0]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2257
        children do:[:aChild|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2258
            anOneArgBlock value:aChild.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2259
            aChild recursiveEachVisibleItemDo:anOneArgBlock.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2260
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2261
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2262
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2263
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2264
subViewsDo:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2265
    "evaluate aBlock for all subviews other than InputView's   
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2266
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2267
    |subViews|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2268
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2269
    subViews := widget subViews.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2270
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2271
    subViews notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2272
        subViews do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2273
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2274
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2275
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2276
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2277
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2278
forView:aView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2279
    widget := aView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2280
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2281
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2282
initialize
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2283
    "setup default attributes
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2284
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2285
    super initialize.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2286
    isDrawnShown := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2287
    isExpanded   := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2288
    children     := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2289
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2290
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2291
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2292
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2293
delete
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2294
    "delete self and all contained items; the assigned views are destroyed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2295
     in case of rootView, only the children are deleted
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2296
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2297
    parent isHierarchicalItem ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2298
        self criticalDo:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2299
            parent remove:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2300
            widget destroy.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2301
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2302
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2303
        self deleteAll
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2304
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2305
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2306
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2307
deleteAll
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2308
    "delete all contained items; the assigned views are destroyed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2309
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2310
    children size == 0 ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2311
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2312
    self criticalDo:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2313
        self nonCriticalDo:[:el| el widget destroy ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2314
        self removeAll
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2315
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2316
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2317
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2318
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2319
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2320
asLayoutFrame
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2321
    "convert the layout of the widget to a LayoutFrame;
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2322
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2323
    |extent layout newLyt lftFrc lftOff topFrc topOff|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2324
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2325
    layout := widget geometryLayout.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2326
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2327
    layout isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2328
        ^ widget bounds asLayout
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2329
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2330
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2331
    layout isLayout ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2332
        layout isRectangle ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2333
            ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2334
                           topOffset:(layout top) bottomOffset:(layout bottom)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2335
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2336
        layout isPoint ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2337
            extent := widget extent.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2338
          ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2339
                         topOffset:(layout y) bottomOffset:(layout y + extent y)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2340
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2341
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2342
        Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2343
      ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2344
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2345
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2346
    layout isLayoutFrame ifTrue:[ ^ layout copy ].    
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2347
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2348
    lftFrc := layout leftFraction.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2349
    lftOff := layout leftOffset.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2350
    topFrc := layout topFraction.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2351
    topOff := layout topOffset.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2352
    extent := widget extent.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2353
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2354
    newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2355
                         rightFraction:lftFrc offset:(lftOff + extent x)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2356
                           topFraction:topFrc offset:topOff
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2357
                        bottomFraction:topFrc offset:(topOff + extent y).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2358
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2359
    (      layout isAlignmentOrigin
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2360
     and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2361
    ) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2362
        |svRc prBd dlta|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2363
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2364
        svRc := widget superView viewRectangle.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2365
        prBd := widget preferredBounds.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2366
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2367
        dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2368
                 - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2369
                ) rounded.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2370
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2371
        newLyt   leftOffset:(lftOff + dlta x).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2372
        newLyt  rightOffset:(lftOff + extent x + dlta x).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2373
        newLyt    topOffset:(topOff + dlta y).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2374
        newLyt bottomOffset:(topOff + extent y + dlta y).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2375
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2376
    ^ newLyt
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2377
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2378
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2379
moveLeft:l top:t
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2380
    "move the widget n pixele left and right
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2381
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2382
    |layout|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2383
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2384
    self isMoveable ifFalse:[ ^ self ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2385
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2386
    (layout := widget geometryLayout) isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2387
        "Extent"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2388
        widget origin:(widget origin + (l@t)).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2389
      ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2390
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2391
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2392
    layout := layout copy.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2393
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2394
    layout isLayout ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2395
        layout leftOffset:(layout leftOffset + l)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2396
                topOffset:(layout topOffset  + t).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2397
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2398
        layout isLayoutFrame ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2399
            layout  rightOffset:(layout rightOffset  + l).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2400
            layout bottomOffset:(layout bottomOffset + t).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2401
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2402
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2403
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2404
        layout isRectangle ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2405
            layout setLeft:(layout left + l).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2406
            layout  setTop:(layout top  + t).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2407
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2408
            layout isPoint ifFalse:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2409
            layout x:(layout x + l) y:(layout y + t).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2410
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2411
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2412
    widget geometryLayout:layout.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2413
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2414
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2415
resizeLeft:l top:t right:r bottom:b
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2416
    "resize the widget measured in pixels
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2417
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2418
    |layout|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2419
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2420
    self isResizeable ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2421
        ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2422
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2423
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2424
    (layout := widget geometryLayout) isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2425
        "Extent"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2426
        (r == l and:[b == t]) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2427
            widget extent:(widget computeExtent + ((r-l) @ (b-t))).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2428
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2429
        ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2430
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2431
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2432
    layout isLayout ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2433
        layout := layout copy.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2434
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2435
        layout leftOffset:(layout leftOffset + l)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2436
                topOffset:(layout topOffset  + t).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2437
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2438
        layout isLayoutFrame ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2439
            layout bottomOffset:(layout bottomOffset + b).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2440
            layout  rightOffset:(layout rightOffset  + r).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2441
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2442
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2443
        layout isRectangle ifFalse:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2444
        layout := layout copy.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2445
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2446
        layout left:(layout left   + l)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2447
              right:(layout right  + r)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2448
                top:(layout top    + t)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2449
             bottom:(layout bottom + b).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2450
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2451
    widget geometryLayout:layout.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2452
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2453
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2454
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2455
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2456
updateChildren
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2457
    |list|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2458
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2459
    self do:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2460
        el exists ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2461
            el updateChildren.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2462
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2463
            list isNil ifTrue:[list := OrderedCollection new].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2464
            list add:el.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2465
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2466
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2467
    list notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2468
        list do:[:el| self remove:el ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2469
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2470
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2471
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2472
updateFromChildren:mergedList
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2473
    "update my children against the list of items derived from
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2474
     the merged list.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2475
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2476
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2477
    mergedList size == 0 ifTrue:[ ^ self removeAll ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2478
    children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2479
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2480
    self criticalDo:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2481
        self nonCriticalDo:[:el| |wdg|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2482
            wdg := el widget.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2483
            mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2484
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2485
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2486
        mergedList keysAndValuesDo:[:i :el| |wdg e2|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2487
            wdg := el widget.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2488
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2489
            e2  := self at:i ifAbsent:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2490
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2491
            (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2492
                self add:el beforeIndex:i
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2493
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2494
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2495
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2496
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2497
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2498
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2499
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2500
icon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2501
    "get the icon used for presentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2502
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2503
    |specClass model|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2504
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2505
    specClass := self specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2506
    specClass isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2507
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2508
    model := self treeModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2509
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2510
    model notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2511
        ^ model iconAt:specClass ifNonePut:[specClass icon]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2512
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2513
    ^ specClass icon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2514
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2515
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2516
label
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2517
    "get the label used for presentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2518
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2519
    ^ self string
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2520
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2521
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2522
printOn:aStream
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2523
    "append a a printed representation of the item to aStream
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2524
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2525
    aStream nextPutAll:(self string)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2526
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2527
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2528
string
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2529
    "get the string
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2530
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2531
    ^ widget class name.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2532
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2533
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2534
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2535
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2536
canChangeLayout
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2537
    "returns true if the layout of the widget can be changed and the
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2538
     layout is not organized by its superView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2539
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2540
    ^ self isResizeable
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2541
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2542
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2543
canResizeSubComponents
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2544
    "returns true if the widget can resize its sub components
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2545
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2546
    |specClass|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2547
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2548
    specClass := self specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2549
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2550
    specClass notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2551
        ^ specClass canResizeSubComponents
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2552
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2553
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2554
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2555
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2556
exists
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2557
    widget id notNil ifTrue:[^ true ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2558
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2559
    exists ~~ false ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2560
        exists := false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2561
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2562
        widget superView notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2563
            (parent isHierarchicalItem and:[parent exists]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2564
                exists := (parent widget subViews includesIdentical:widget).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2565
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2566
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2567
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2568
    ^ exists
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2569
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2570
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2571
isApplicationClass
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2572
    |cls|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2573
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2574
    cls := widget class.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2575
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2576
    ^ (    cls == ApplicationSubView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2577
        or:[cls == ApplicationWindow
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2578
        or:[cls == SubCanvas]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2579
      ) 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2580
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2581
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2582
isSelected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2583
    |model|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2584
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2585
    model := self treeModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2586
    model notNil ifTrue:[^ model isSelected:self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2587
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2588
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2589
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2590
supportsSubComponents
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2591
    "returns true if the widget supports sub components
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2592
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2593
    |specClass|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2594
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2595
    widget isScrollWrapper ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2596
        ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2597
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2598
    specClass := self specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2599
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2600
    specClass notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2601
        ^ specClass supportsSubComponents
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2602
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2603
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2604
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2605
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2606
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2607
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2608
isInLayoutContainer
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2609
    "returns true if the widget is in a layout container
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2610
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2611
    |sv specClass|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2612
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2613
    sv := widget superView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2614
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2615
    sv notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2616
        specClass := sv specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2617
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2618
        specClass notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2619
            ^ specClass isLayoutContainer
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2620
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2621
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2622
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2623
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2624
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2625
isLayoutContainer
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2626
    "answer whether corresponding view instances of the spec class can contain
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2627
     (and arrange) other view
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2628
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2629
    |specClass|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2630
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2631
    specClass := self specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2632
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2633
    specClass notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2634
        ^ specClass isLayoutContainer
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2635
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2636
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2637
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2638
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2639
isMoveable
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2640
    "returns true if the widget is not in a layout container
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2641
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2642
    self isInLayoutContainer ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2643
        ^ widget superView notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2644
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2645
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2646
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2647
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2648
isResizeable
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2649
    "returns true if the widget is resizeable
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2650
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2651
    |sv specClass|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2652
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2653
    sv := widget superView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2654
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2655
    sv notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2656
        specClass := sv specClass.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2657
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2658
        specClass notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2659
            ^ specClass canResizeSubComponents
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2660
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2661
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2662
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2663
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2664
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2665
!ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2666
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2667
documentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2668
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2669
    Instances of ViewTreeModel can be used as model on a View and all
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2670
    it contained subviews for a HierarchicalListView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2671
    The model keeps two values, the hierarchical representation of the views
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2672
    and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2673
    It shows the selected items highlighted.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2674
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2675
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2676
    [Instance variables:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2677
        lockSema            <Semaphore>         lock selection notifications and redraws
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2678
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2679
        testModeChannel     <ValueHolder>       true, than running in test mode.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2680
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2681
        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2682
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2683
        selection           <Sequence or nil>   selected items or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2684
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2685
        hiddenLevel         <Integer>           internal use; redrawing the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2686
                                                only is done if the counter is 0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2687
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2688
        listOfItems         <HierarchicalList>  hiearchical list build from existing items.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2689
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2690
        selectedSuperItems  <Sequence>          list of selected super items; items selected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2691
                                                but not contained in another selected item.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2692
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2693
        inputEventAction    <Action>            called for each InputEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2694
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2695
        mappedViewAction    <Action>            called for a new mapped view which
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2696
                                                can not be found in the current item list.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2697
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2698
        beforeSelectionChangedAction <Action>   called before the selection changed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2699
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2700
    [author:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2701
        Claus Atzkern
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2702
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2703
    [see also:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2704
        ViewTreeItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2705
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2706
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2707
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2708
examples
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2709
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2710
    example 1: pick any window and show views and contained views
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2711
                                                                                [exBegin]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2712
    |top sel model panel|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2713
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2714
    model := ViewTreeModel new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2715
    top   := StandardSystemView new; extent:440@400.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2716
    sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2717
    sel bottomInset:24.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2718
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2719
    panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2720
    panel topInset:-24.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2721
    panel horizontalLayout:#fitSpace.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2722
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2723
    Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2724
    Button label:'Pick Views' action:[  |win|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2725
                                        (     (win := Screen current viewFromUser) notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2726
                                         and:[(win := win topView) ~~ Screen current rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2727
                                         and:[win ~~ top]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2728
                                        ) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2729
                                            model rootItem:(ViewTreeItem buildViewsFrom:win)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2730
                                        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2731
                                            model rootItem:nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2732
                                        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2733
                                     ] in:panel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2734
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2735
    sel  multipleSelectOk:true.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2736
    sel              list:model listOfItems.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2737
    sel             model:model.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2738
    sel          useIndex:false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2739
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2740
    sel doubleClickAction:[:i| |el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2741
        el := model listOfItems at:i.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2742
        el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2743
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2744
    sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2745
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2746
    model inputEventAction:[:anEvent| |item|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2747
        anEvent isButtonEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2748
            anEvent isButtonPressEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2749
                model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2750
            ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2751
                anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2752
                    (item := model selectedItem) notNil ifTrue:[item widget inspect]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2753
                ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2754
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2755
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2756
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2757
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2758
    top openAndWait.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2759
    [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2760
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2761
                                                                                [exEnd]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2762
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2763
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2764
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2765
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2766
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2767
application:anApplication
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2768
    listOfItems application:anApplication.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2769
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2770
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2771
rootItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2772
    "get the rootItem the event viewer is established on
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2773
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2774
    ^ listOfItems root
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2775
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2776
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2777
rootItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2778
    "set the rootItem the event viewer is established on
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2779
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2780
    |expanded|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2781
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2782
    timedUpdateTask := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2783
    self deselect.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2784
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2785
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2786
        anItem notNil ifTrue:[ expanded := anItem isExpanded ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2787
                     ifFalse:[ expanded := false ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2788
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2789
        self value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2790
        listOfItems root:anItem.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2791
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2792
        anItem notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2793
            timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2794
            timedUpdateTask name:'Update'.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2795
            timedUpdateTask resume.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2796
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2797
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2798
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2799
    (expanded and:[anItem notNil]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2800
        anItem expand
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2801
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2802
    ^ anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2803
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2804
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2805
rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2806
    "get the top widget the event viewer is established on, a View
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2807
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2808
    ^ listOfItems rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2809
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2810
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2811
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2812
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2813
beforeSelectionChangedAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2814
    "none argument action which is called before
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2815
     the selection changed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2816
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2817
    ^ beforeSelectionChangedAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2818
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2819
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2820
beforeSelectionChangedAction:aNoneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2821
    "none argument action which is called before
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2822
     the selection changed
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2823
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2824
    beforeSelectionChangedAction := aNoneArgBlock.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2825
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2826
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2827
inputEventAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2828
    "called for each input event; the argument to the action is the WindowEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2829
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2830
    ^ inputEventAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2831
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2832
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2833
inputEventAction:aOneArgActionTheEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2834
    "called for each input event; the argument to the action is the WindowEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2835
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2836
    inputEventAction := aOneArgActionTheEvent.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2837
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2838
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2839
mappedViewAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2840
    "called for a new mapped view which can not be found
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2841
     in the current item list
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2842
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2843
    ^ mappedViewAction
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2844
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2845
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2846
mappedViewAction:aOneArgBlockTheMappedView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2847
    "called for a new mapped view which can not be found
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2848
     in the current item list
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2849
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2850
    mappedViewAction := aOneArgBlockTheMappedView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2851
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2852
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2853
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2854
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2855
iconAt:aKey ifNonePut:aNoneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2856
    |icon view|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2857
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2858
    icon := icons at:aKey ifAbsent:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2859
    icon notNil ifTrue:[^ icon].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2860
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2861
    icon := aNoneArgBlock value.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2862
    icon isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2863
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2864
    view := self rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2865
    view isNil ifTrue:[^ icon].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2866
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2867
    icon := icon copy onDevice:(view device).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2868
    icon isImage ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2869
        icon clearMaskedPixels.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2870
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2871
    icons at:aKey put:icon.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2872
    ^ icon
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2873
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2874
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2875
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2876
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2877
signalHiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2878
    "show the selection if signaled; increments hiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2879
     see: #waitHiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2880
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2881
    (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2882
        hiddenLevel := 0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2883
        self invalidateSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2884
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2885
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2886
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2887
waitHiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2888
    "hide the selection until signaled; increments hiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2889
     see: #signalHiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2890
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2891
    self redrawUnselected:selection andLock:true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2892
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2893
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2894
withSelectionHiddenDo:aNoneArgumentBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2895
    "apply block with selection hidden
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2896
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2897
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2898
    [   self waitHiddenLevel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2899
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2900
        aNoneArgumentBlock value
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2901
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2902
    ] valueNowOrOnUnwindDo:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2903
        self signalHiddenLevel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2904
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2905
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2906
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2907
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2908
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2909
hasTargetWidgetChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2910
    "answer the channel which is set to true if a target widget exists"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2911
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2912
    ^ hasTargetWidgetChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2913
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2914
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2915
listOfItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2916
    "hiearchical list build from existing items"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2917
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2918
    ^ listOfItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2919
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2920
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2921
selectOnClickHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2922
    "boolean holder, which indicates whether the selection will change on click
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2923
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2924
    ^ selectOnClickHolder
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2925
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2926
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2927
testModeChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2928
    "answer a boolean channel which describes the behaviour how to process
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2929
     events on the target view.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2930
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2931
     false: all input events are eaten and the selection is shown on the target view.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2932
     true:  no  input events are eaten and no  selection is shown on the target view."
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2933
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2934
    ^ testModeChannel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2935
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2936
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2937
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2938
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2939
targetWidgetChanged
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2940
    hasTargetWidgetChannel value:(self rootItem notNil).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2941
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2942
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2943
timedUpdateTaskCycle
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2944
    |view myTaskId|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2945
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2946
    myTaskId := timedUpdateTask.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2947
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2948
    listOfItems root notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2949
        view := listOfItems root widget.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2950
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2951
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2952
    [ view notNil ] whileTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2953
        Delay waitForSeconds:0.5.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2954
        
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2955
        (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2956
            view := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2957
        ] ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2958
            (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2959
                view sensor pushUserEvent:#updateChildren for:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2960
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2961
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2962
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2963
    timedUpdateTask == myTaskId ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2964
        timedUpdateTask := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2965
        listOfItems root:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2966
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2967
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2968
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2969
update:something with:someArgument from:aModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2970
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2971
    aModel == testModeChannel ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2972
        (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2973
            testModeChannel value ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2974
                self redrawUnselected:selection andLock:false checkTestMode:false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2975
            ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2976
                self invalidateSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2977
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2978
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2979
        ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2980
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2981
    super update:something with:someArgument from:aModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2982
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2983
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2984
updateChildren
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2985
    |rootItem|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2986
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2987
    rootItem := listOfItems root.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2988
    rootItem isNil ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2989
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2990
    rootItem exists ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2991
        listOfItems root:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2992
    ] ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2993
        rootItem updateChildren.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2994
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2995
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2996
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2997
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2998
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2999
processEvent:anEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3000
    "catch and process all WindowEvents for the rootComponent and its contained
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
  3001
     widgets; redraw selection in case of damage...
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
  3002
     return true, if the event was eaten"
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
  3003
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3004
    |evView item rootView testMode|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3005
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3006
    evView := anEvent view.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3007
    evView isNil ifTrue:[
2757
6c83d6b487b2 changed:
Claus Gittinger <cg@exept.de>
parents: 2748
diff changeset
  3008
        (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3009
            ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3010
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3011
        anEvent value.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3012
        ^ true.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3013
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3014
    rootView := listOfItems rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3015
    rootView isNil ifTrue:[ ^ false ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3016
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3017
    anEvent isConfigureEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3018
        hiddenLevel == 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3019
            self redrawUnselected:selection andLock:false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3020
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3021
        ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3022
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3023
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3024
    "/ check whether view is contained within the rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3025
    (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3026
        ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3027
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3028
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3029
    anEvent isInputEvent ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3030
        anEvent isDamage ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3031
            hiddenLevel == 0 ifTrue:[self invalidateSelection].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3032
            ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3033
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3034
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3035
        anEvent isMapEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3036
            mappedViewAction notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3037
                item := listOfItems recursiveDetect:[:el| el widget == evView].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3038
                item isNil ifTrue:[ mappedViewAction value:evView ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3039
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3040
            ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3041
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3042
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3043
        anEvent type == #terminate ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3044
            item := listOfItems recursiveDetect:[:el| el widget == evView].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3045
            item notNil ifTrue:[ self processTerminateForItem:item ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3046
            ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3047
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3048
        ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3049
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3050
    testMode := testModeChannel value.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3051
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3052
    anEvent isFocusEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3053
        evView == rootView ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3054
            self invalidateSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3055
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3056
        ^ testMode not.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3057
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3058
    anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3059
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3060
    testMode ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3061
        inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3062
    ] ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3063
        anEvent isButtonPressEvent ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3064
            selectOnClickHolder value ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3065
                self selectItem:(listOfItems detectItemRespondsToView:evView).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3066
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3067
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3068
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3069
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3070
    (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3071
        hiddenLevel := 1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3072
        self signalHiddenLevel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3073
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3074
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3075
    ^ testMode not
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3076
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3077
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3078
processTerminateForItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3079
    "received terminate for an item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3080
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3081
    anItem remove.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3082
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3083
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3084
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3085
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3086
initialize
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3087
    "setup the default attributes
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3088
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3089
    super initialize.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3090
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3091
    hiddenLevel           := 0.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3092
    lockSema              := RecursionLock new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3093
    listOfItems           := ItemList new on:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3094
    selectedSuperItems    := #().
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3095
    icons                 := IdentityDictionary new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3096
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3097
    hasTargetWidgetChannel := false asValue.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3098
    selectOnClickHolder    := true asValue.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3099
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3100
    testModeChannel := false asValue.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3101
    testModeChannel addDependent:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3102
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3103
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3104
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3105
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3106
invalidateSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3107
    "invalidate the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3108
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3109
    |topView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3110
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3111
    testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3112
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3113
    (     hiddenLevel == 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3114
     and:[selection notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3115
     and:[(topView := listOfItems rootView) notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3116
     and:[topView shown]]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3117
    ) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3118
        topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3119
    ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3120
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3121
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3122
recursiveRepair:theDamages startIn:aView relativeTo:aRootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3123
    "repair all views and contained views, which intersects the damage.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3124
     !!!! all damages repaired are removed from the list of damages !!!!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3125
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3126
    |color relOrg damage subViews repaired
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3127
     bwWidth    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3128
     x          "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3129
     y          "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3130
     w          "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3131
     h          "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3132
     relOrgX    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3133
     relOrgY    "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3134
     width      "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3135
     height     "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3136
     size       "{ Class:SmallInteger }"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3137
    |
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3138
    (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3139
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3140
    subViews := aView subViews.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3141
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3142
    subViews size ~~ 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3143
        subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3144
        theDamages isEmpty ifTrue:[ ^ self ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3145
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3146
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3147
    relOrg  := aView originRelativeTo:aRootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3148
    bwWidth := aView borderWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3149
    size    := theDamages size.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3150
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3151
    "/ compute relative origin starting from border left@top
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3152
    relOrgX := relOrg x - bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3153
    relOrgY := relOrg y - bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3154
    width   := aView width  + bwWidth + bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3155
    height  := aView height + bwWidth + bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3156
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3157
    size to:1 by:-1 do:[:anIndex|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3158
        repaired := damage := theDamages at:anIndex.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3159
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3160
        "/ compute the rectangle into the view
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3161
        y := damage top  - relOrgY.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3162
        x := damage left - relOrgX.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3163
        w := damage width.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3164
        h := damage height.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3165
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3166
        x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3167
        y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3168
        x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3169
        y + h > height ifTrue:[ h := height - y.    repaired := nil ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3170
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3171
        (w > 0 and:[h > 0]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3172
            bwWidth ~~ 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3173
                color isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3174
                    "/ must force redraw of border
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3175
                    color := aView borderColor.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3176
                    aView borderColor:(Color colorId:1).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3177
                    aView borderColor:color.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3178
                ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3179
                w := w - bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3180
                h := h - bwWidth.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3181
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3182
                (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3183
                (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3184
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3185
                h > 0 ifFalse:[w := 0].         "/ later testing on width only
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3186
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3187
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3188
            w > 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3189
                aView clearRectangleX:x y:y width:w height:h.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3190
                aView exposeX:x y:y width:w height:h
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3191
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3192
            repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3193
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3194
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3195
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3196
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3197
redrawSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3198
    "redraw all items selected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3199
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3200
    |topView size|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3201
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3202
    testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3203
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3204
    (     hiddenLevel == 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3205
     and:[(size := selection size) > 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3206
     and:[(topView := listOfItems rootView) notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3207
     and:[topView shown
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3208
     and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3209
    ) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3210
        ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3211
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3212
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3213
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3214
        |list|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3215
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3216
        list := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3217
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3218
        list size > 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3219
            topView paint:(Color black).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3220
            topView clippedByChildren:false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3221
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3222
            list keysAndValuesReverseDo:[:anIndex :anItem|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3223
                (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3224
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3225
                anItem handlesDo:[:aRect :what|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3226
                    what isNil ifTrue:[topView displayRectangle:aRect]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3227
                              ifFalse:[topView    fillRectangle:aRect]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3228
                ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3229
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3230
            topView clippedByChildren:true.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3231
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3232
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3233
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3234
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3235
redrawUnselected:aList andLock:doLock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3236
    "redraw all items unselected; if doLock is true, the hiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3237
     is incremented and thus the select mechanism is locked.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3238
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3239
    self redrawUnselected:aList andLock:doLock checkTestMode:true.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3240
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3241
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3242
redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3243
    "redraw all items unselected; if doLock is true, the hiddenLevel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3244
     is incremented and thus the select mechanism is locked.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3245
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3246
    |rootView damages subViews x y w h|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3247
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3248
    doLock ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3249
        hiddenLevel := hiddenLevel + 1.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3250
        hiddenLevel ~~ 1 ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3251
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3252
        hiddenLevel ~~ 0 ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3253
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3254
    checkTestMode ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3255
        testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3256
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3257
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3258
    (     aList size ~~ 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3259
     and:[(rootView := listOfItems rootView) notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3260
     and:[rootView shown]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3261
    ) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3262
        ^ self
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3263
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3264
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3265
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3266
        damages := OrderedCollection new:(8 * aList size).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3267
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3268
        aList do:[:item|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3269
            item handlesDo:[:handle :what|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3270
                damages reverseDo:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3271
                    (el intersects:handle) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3272
                        damages removeIdentical:el.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3273
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3274
                        handle left:(handle left   min:el left)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3275
                              right:(handle right  max:el right)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3276
                                top:(handle top    min:el top)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3277
                             bottom:(handle bottom max:el bottom)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3278
                    ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3279
                ].                        
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3280
                damages add:handle
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3281
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3282
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3283
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3284
        damages do:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3285
            x := el left.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3286
            y := el top.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3287
            w := el width.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3288
            h := el height.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3289
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3290
            rootView clearRectangleX:x y:y width:w height:h.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3291
            rootView         exposeX:x y:y width:w height:h.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3292
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3293
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3294
        (subViews := rootView subViews) notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3295
            subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3296
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3297
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3298
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3299
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3300
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3301
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3302
isInTestMode
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3303
    "answer false, all input events are eaten and the selection is shown on the target view.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3304
     answer true,  no  input events are eaten and no  selection is shown on the target view."
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3305
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3306
    ^ testModeChannel value
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3307
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3308
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3309
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3310
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3311
at:anIndex
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3312
    "returns the selected item at an index or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3313
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3314
    selection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3315
        ^ selection at:anIndex ifAbsent:nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3316
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3317
    ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3318
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3319
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3320
at:anIndex ifAbsent:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3321
    "returns the selected item at an index or the result of the block
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3322
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3323
    selection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3324
        ^ selection at:anIndex ifAbsent:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3325
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3326
    ^ aBlock value
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3327
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3328
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3329
first
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3330
    "returns the first selected item or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3331
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3332
    ^ self at:1
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3333
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3334
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3335
last
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3336
    "returns the last selected item or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3337
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3338
    ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3339
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3340
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3341
selectedItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3342
    "returns the single selected item or nil (size ~~ 1 nil is returned)
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3343
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3344
    ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3345
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3346
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3347
selectedSuperItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3348
    "returs the list of selected superItems; items selected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3349
     but not contained in another selected item.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3350
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3351
    ^ selectedSuperItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3352
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3353
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3354
size
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3355
    "returns the number of items selected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3356
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3357
    ^ selection size
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3358
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3359
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3360
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3361
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3362
add:item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3363
    "add an item to the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3364
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3365
    |newSelect|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3366
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3367
    item isNil ifTrue:[^ item].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3368
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3369
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3370
        selection isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3371
            newSelect := Array with:item.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3372
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3373
            (self includes:item) ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3374
                newSelect := selection copyWith:item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3375
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3376
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3377
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3378
        newSelect size ~~ selection size ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3379
            item makeVisible.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3380
            self value:newSelect
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3381
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3382
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3383
    ^ item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3384
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3385
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3386
addAll:aCollectionOfItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3387
    "add a collection of items to the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3388
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3389
    |newSelect|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3390
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3391
    aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3392
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3393
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3394
        selection isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3395
            newSelect := Array withAll:aCollectionOfItems.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3396
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3397
            newSelect := OrderedCollection withAll:selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3398
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3399
            aCollectionOfItems do:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3400
                (selection includesIdentical:el) ifFalse:[newSelect add:el]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3401
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3402
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3403
        self value:newSelect.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3404
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3405
    ^ aCollectionOfItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3406
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3407
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3408
deselect
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3409
    "clear the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3410
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3411
    self value:nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3412
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3413
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3414
remove:item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3415
    "remove the item from the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3416
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3417
    |newSelect|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3418
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3419
    item isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3420
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3421
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3422
        (selection notNil and:[selection includesIdentical:item]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3423
            selection size == 1 ifTrue:[ newSelect := nil ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3424
                               ifFalse:[ newSelect := selection copyWithout:item ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3425
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3426
            self value:newSelect
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3427
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3428
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3429
    ^ item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3430
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3431
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3432
removeAll
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3433
    "clear the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3434
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3435
    self deselect.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3436
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3437
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3438
removeAll:loItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3439
    "remove all items of the collection from the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3440
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3441
    |newSelect|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3442
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3443
    selection   isNil ifTrue:[ ^ loItems ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3444
    loItems size == 0 ifTrue:[ ^ loItems ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3445
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3446
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3447
        selection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3448
            newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3449
            self value:newSelect.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3450
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3451
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3452
    ^ loItems
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3453
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3454
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3455
selectAll
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3456
    "select all items
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3457
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3458
    |root newSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3459
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3460
    root := listOfItems root.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3461
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3462
    root isNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3463
        newSelection := nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3464
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3465
        newSelection := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3466
        root recursiveDo:[:el| newSelection add:el ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3467
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3468
    self value:newSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3469
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3470
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3471
selectItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3472
    "set the current selection to the item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3473
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3474
    self value:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3475
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3476
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3477
selectRootItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3478
    "set the current selection to the root item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3479
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3480
    self value:(self rootItem).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3481
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3482
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3483
selectedItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3484
    "set the current selection to the item
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3485
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3486
    self selectItem:anItem.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3487
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3488
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3489
toggleSelectItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3490
    "toggle selection-state of the item; add or remove the item from the
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3491
     current selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3492
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3493
    anItem notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3494
        (self includes:anItem) ifTrue:[self remove:anItem]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3495
                              ifFalse:[self add:anItem]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3496
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3497
    ^ anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3498
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3499
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3500
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3501
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3502
collect:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3503
    "for each element in the selection, evaluate the argument, aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3504
     and return a new collection with the results
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3505
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3506
    |res|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3507
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3508
    res := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3509
    self do:[:el| res add:(aBlock value:el)].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3510
  ^ res
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3511
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3512
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3513
do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3514
    "evaluate the argument, aBlock for each item in the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3515
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3516
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3517
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3518
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3519
    cashedSelection isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3520
  ^ cashedSelection do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3521
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3522
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3523
from:start do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3524
    "evaluate the argument, aBlock for the items starting at index start
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3525
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3526
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3527
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3528
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3529
    cashedSelection isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3530
  ^ cashedSelection from:start do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3531
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3532
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3533
from:start to:stop do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3534
    "evaluate the argument, aBlock for the items with index start to
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3535
     stop in the selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3536
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3537
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3538
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3539
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3540
    cashedSelection isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3541
  ^ cashedSelection from:start to:stop do:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3542
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3543
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3544
reverseDo:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3545
    "evaluate the argument, aBlock for each item in the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3546
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3547
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3548
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3549
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3550
    cashedSelection isNil ifTrue:[^ nil].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3551
  ^ cashedSelection reverseDo:aOneArgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3552
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3553
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3554
select:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3555
    "return a new collection with all elements from the selection, for which
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3556
     the argument aBlock evaluates to true.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3557
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3558
    |res|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3559
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3560
    res := OrderedCollection new.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3561
    self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3562
  ^ res
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3563
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3564
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3565
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3566
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3567
changed:aParameter with:oldSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3568
    "update the visibility staus of the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3569
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3570
    |unselected rootView rootItem selSize|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3571
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3572
    selSize := selection size.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3573
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3574
    selSize == 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3575
        selectedSuperItems := #().
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3576
    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3577
        selSize == 1 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3578
            selectedSuperItems := Array with:(selection at:1).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3579
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3580
            rootItem := listOfItems root.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3581
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3582
            (selection includesIdentical:rootItem) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3583
                selectedSuperItems := Array with:rootItem.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3584
            ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3585
                selectedSuperItems := OrderedCollection new:selSize.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3586
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3587
                selection do:[:anItem|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3588
                    anItem parentsDetect:[:el| selection includesIdentical:el ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3589
                                  ifNone:[ selectedSuperItems add:anItem ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3590
                ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3591
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3592
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3593
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3594
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3595
    (     hiddenLevel == 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3596
     and:[(rootView := listOfItems rootView) notNil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3597
     and:[rootView shown]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3598
    ) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3599
        selSize == 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3600
            "/ must redraw the old selection unselected
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3601
            self redrawUnselected:oldSelection andLock:false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3602
        ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3603
            self invalidateSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3604
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3605
            oldSelection size ~~ 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3606
                "/ must redraw all elements no longer in the selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3607
                unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3608
                self redrawUnselected:unselected andLock:false.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3609
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3610
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3611
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3612
    super changed:aParameter with:oldSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3613
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3614
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3615
setValue:aNewSelection 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3616
    "set the selection without notifying
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3617
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3618
    |newSelect idx|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3619
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3620
    newSelect := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3621
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3622
    aNewSelection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3623
        lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3624
            aNewSelection isCollection ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3625
                (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3626
                    newSelect := selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3627
                ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3628
                    newSelect := Array with:aNewSelection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3629
                ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3630
            ] ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3631
                aNewSelection notEmpty ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3632
                    aNewSelection size ~~ selection size ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3633
                        newSelect := aNewSelection copy.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3634
                    ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3635
                        idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3636
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3637
                        idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3638
                                ifFalse:[newSelect := selection ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3639
                    ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3640
                ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3641
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3642
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3643
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3644
    newSelect ~~ selection ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3645
        beforeSelectionChangedAction value.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3646
        selection := newSelect.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3647
        selection notNil ifTrue:[selection do:[:el| el makeVisible]]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3648
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3649
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3650
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3651
triggerValue:aValue
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3652
    "set my value & send change notifications to my dependents.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3653
     Send the change message even if the value didn't change.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3654
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3655
    |oldSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3656
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3657
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3658
        oldSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3659
        self setValue:aValue.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3660
        self changed:#value with:oldSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3661
    ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3662
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3663
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3664
value
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3665
    "returns the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3666
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3667
    ^ selection ? #()
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3668
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3669
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3670
value:aValue
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3671
    "change the current selection and send change notifications to my
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3672
     dependents if it changed.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3673
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3674
    |oldSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3675
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3676
    lockSema critical:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3677
        oldSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3678
        self setValue:aValue.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3679
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3680
        oldSelection == selection ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3681
            self changed:#value with:oldSelection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3682
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3683
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3684
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3685
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3686
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3687
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3688
detect:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3689
    "evaluate the argument, aBlock for each item in the selection until
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3690
     the block returns true; in this case return the element which caused
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3691
     the true evaluation.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3692
     If none of the evaluations returns true, an error is raised
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3693
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3694
    ^ self detect:aBlock ifNone:[self errorNotFound]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3695
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3696
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3697
detect:aBlock ifNone:exceptionBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3698
    "evaluate the argument, aBlock for each item in the selection until the
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3699
     block returns true; in this case return the element which caused the
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3700
     true evaluation.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3701
     If none of the evaluations returns true, the result of the evaluation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3702
     of the exceptionBlock is returned
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3703
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3704
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3705
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3706
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3707
    cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3708
  ^ cashedSelection detect:aBlock ifNone:exceptionBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3709
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3710
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3711
detectLast:aBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3712
    "evaluate the argument, aBlock for each item in the selection until
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3713
     the block returns true; in this case return the element which caused
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3714
     the true evaluation. The items are processed in reverse order.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3715
     If none of the evaluations returns true, an error is raised
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3716
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3717
    ^ self detectLast:aBlock ifNone:[self errorNotFound]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3718
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3719
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3720
detectLast:aBlock ifNone:exceptionBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3721
    "evaluate the argument, aBlock for each item in the selection until
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3722
     the block returns true; in this case return the element which caused
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3723
     the true evaluation. The items are processed in reverse order.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3724
     If none of the evaluations returns true, the result of the evaluation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3725
     of the exceptionBlock is returned
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3726
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3727
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3728
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3729
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3730
    cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3731
  ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3732
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3733
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3734
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3735
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3736
includes:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3737
    "returns true if the item is in the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3738
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3739
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3740
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3741
    cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3742
    cashedSelection isNil ifTrue:[^ false].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3743
 ^  cashedSelection includesIdentical:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3744
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3745
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3746
includesAll:aCollection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3747
    "return true, if all items of the collection are included in the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3748
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3749
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3750
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3751
    aCollection size ~~ 0 ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3752
        cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3753
        cashedSelection isNil ifTrue:[ ^ false ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3754
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3755
        aCollection do:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3756
            (cashedSelection includesIdentical:el) ifFalse:[^ false]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3757
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3758
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3759
    ^ true
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3760
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3761
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3762
includesAny:aCollection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3763
    "return true, if the any item of the collection is in the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3764
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3765
    |cashedSelection|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3766
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3767
    aCollection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3768
        cashedSelection := selection.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3769
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3770
        cashedSelection notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3771
            aCollection do:[:el|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3772
                (cashedSelection includesIdentical:el) ifTrue:[^ true]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3773
            ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3774
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3775
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3776
    ^ false
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3777
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3778
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3779
includesIdentical:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3780
    "returns true if the item is in the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3781
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3782
    ^ self includes:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3783
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3784
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3785
isEmpty
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3786
    "returns true if the current selection is empty
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3787
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3788
    ^ selection size == 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3789
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3790
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3791
isSelected:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3792
    "returns true if the item is in the current selection
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3793
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3794
    ^ self includes:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3795
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3796
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3797
notEmpty
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3798
    "returns true if the current selection is not empty
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3799
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3800
    ^ selection size ~~ 0
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3801
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3802
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3803
!ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3804
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3805
documentation
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3806
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3807
    Kind of HierarchicalList class which contains all the visible
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3808
    ViewTreeItem's and the root, the anchor of the hierarchical list.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3809
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3810
    [Instance variables:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3811
        treeModel       <ViewTreeModel>         all events are delegated to
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3812
        eventHook       <BlockValue>            save and resore the pre/post -EventHook
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3813
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3814
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3815
    [author:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3816
        Claus Atzkern
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3817
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3818
    [see also:]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3819
        HierarchicalList
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3820
        ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3821
        ViewTreeItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3822
"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3823
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3824
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3825
!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3826
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3827
root:theRoot
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3828
    "set the root item; delegate events to my treeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3829
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3830
    |rootView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3831
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3832
    theRoot == root ifTrue:[^ self].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3833
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3834
    rootView := self rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3835
    super root:theRoot.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3836
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3837
    rootView notNil ifTrue:[ |wgrp|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3838
        wgrp := rootView windowGroup.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3839
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3840
        wgrp notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3841
           wgrp removePreEventHook:treeModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3842
           wgrp removePostEventHook:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3843
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3844
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3845
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3846
    super root:theRoot.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3847
    rootView := self rootView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3848
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3849
    rootView notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3850
        "must setup a task because there might not exist a windowGroup at the moment
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3851
        "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3852
        [   |wgrp|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3853
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3854
            [rootView == self rootView] whileTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3855
                wgrp := rootView windowGroup.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3856
                wgrp notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3857
                    rootView := nil.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3858
                    wgrp addPreEventHook:treeModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3859
                    wgrp addPostEventHook:self.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3860
                ] ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3861
                    Delay waitForMilliseconds:100.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3862
                ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3863
            ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3864
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3865
        ] forkAt:(Processor userSchedulingPriority + 2).
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3866
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3867
    treeModel notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3868
        treeModel targetWidgetChanged.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3869
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3870
    
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3871
    ^ root.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3872
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3873
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3874
rootView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3875
    "returns the widget assigned to the root or nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3876
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3877
    ^ root notNil ifTrue:[root widget] ifFalse:[nil]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3878
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3879
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3880
treeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3881
    "returne the treeModel, a ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3882
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3883
    ^ treeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3884
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3885
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3886
!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3887
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3888
additionalLabelForItem:anItem
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3889
    "answer the additional lable for an item or nil"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3890
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3891
    |l applClass applClassName|
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3892
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3893
    l := nil.
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3894
    showWidgetNames == true ifTrue:[
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3895
        l := '"', anItem widget name, '"'
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3896
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3897
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3898
    anItem isApplicationClass ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3899
        applClass := anItem applicationClass.
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3900
        applClass notNil ifTrue:[   
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3901
            applClassName := '[', applClass name allBold, ']'.
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3902
            l := (l isNil ifTrue:[''] ifFalse:[l , ' ']) , applClassName
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3903
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3904
    ].
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3905
    ^ l
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3906
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3907
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3908
showWidgetNames
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3909
    "answer true if the additional text is the widget name
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3910
     otherwise the name of the application"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3911
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3912
    ^ showWidgetNames ? true
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3913
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3914
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3915
showWidgetNames:aBoolean
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3916
    "set true if the additional text is the widget name
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3917
     otherwise the name of the application"
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3918
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3919
    self showWidgetNames == aBoolean ifFalse:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3920
        showWidgetNames := aBoolean.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3921
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3922
        root notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3923
            root recursiveAdditionalNameBehaviourChanged.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3924
            self changed.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3925
        ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3926
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3927
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3928
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3929
!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3930
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3931
processEvent:anEvent
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3932
    "post process event
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3933
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3934
    ^ treeModel isInTestMode not
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3935
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3936
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3937
!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3938
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3939
on:aModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3940
    "set the model, a ViewTreeModel
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3941
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3942
    treeModel := aModel.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3943
    showRoot  := true.
2762
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3944
    "/ showWidgetNames := false.
Claus Gittinger <cg@exept.de>
parents: 2759
diff changeset
  3945
    showWidgetNames := true.
2744
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3946
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3947
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3948
!ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3949
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3950
detectItemRespondsToView:aView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3951
    "returns the bottom-most item which contains the view
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3952
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3953
    |view item topView|
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3954
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3955
    root notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3956
        view    := aView.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3957
        topView := root widget.
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3958
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3959
        [ view notNil ] whileTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3960
            topView == view ifTrue:[^ root].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3961
            item := root recursiveDetect:[:el| el widget == view ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3962
            item notNil ifTrue:[^ item].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3963
            view := view superView
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3964
        ]
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3965
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3966
    ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3967
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3968
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3969
recursiveDetect:aOneOrgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3970
    "recursive find the first child, for which evaluation 
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3971
     of the block returns true; if none nil is returned
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3972
    "
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3973
    root notNil ifTrue:[
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3974
        (aOneOrgBlock value:root) ifTrue:[ ^ root ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3975
      ^ root recursiveDetect:aOneOrgBlock
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3976
    ].
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3977
    ^ nil
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3978
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3979
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3980
!ViewTreeInspectorApplication class methodsFor:'documentation'!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3981
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3982
version
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3983
    ^ '$Header$'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3984
!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3985
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3986
version_CVS
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3987
    ^ '$Header$'
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3988
! !
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3989
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3990
ViewTreeInspectorApplication initialize!
5bee95e91ffd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3991
ViewTreeInspectorApplication::ViewTreeItem initialize!