PullDownMenu.st
author Claus Gittinger <cg@exept.de>
Wed, 17 Jan 1996 12:18:40 +0100
changeset 291 71f4a66b3281
parent 289 82d20a3e2fe8
child 309 b5c9d68e95e1
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
5
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     3
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     4
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
119
claus
parents: 116
diff changeset
    13
SimpleView subclass:#PullDownMenu
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    14
	instanceVariableNames:'receiver menus titles selectors activeMenuNumber
250
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    15
		showSeparatingLines topMargin fgColor bgColor activeFgColor
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    16
		activeBgColor onLevel offLevel edgeStyle keepMenu toggleKeep
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    17
		raiseTopWhenActivated'
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    18
	classVariableNames:'DefaultFont DefaultViewBackground DefaultForegroundColor
250
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    19
		DefaultBackgroundColor DefaultHilightForegroundColor
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    20
		DefaultHilightBackgroundColor DefaultLevel DefaultHilightLevel
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    21
		DefaultShadowColor DefaultLightColor DefaultEdgeStyle
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
    22
		DefaultKeepMenu DefaultToggleKeep DefaultSeparatingLines'
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    23
	poolDictionaries:''
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    24
	category:'Views-Menus'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    25
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    26
3
claus
parents: 0
diff changeset
    27
!PullDownMenu class methodsFor:'documentation'!
claus
parents: 0
diff changeset
    28
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    29
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    30
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    31
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    32
	      All Rights Reserved
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    33
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    34
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    35
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    37
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    38
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    39
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    40
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    41
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    42
3
claus
parents: 0
diff changeset
    43
documentation
claus
parents: 0
diff changeset
    44
"
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    45
    PullDown menu provides the top (always visible) part of these menus. 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    46
    It controls display of its menus, which become visible when one of the 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    47
    PullDownMenus entries is pressed.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    48
128
claus
parents: 119
diff changeset
    49
    A PullDownMenu itself consists of a single row of labels, which activate
claus
parents: 119
diff changeset
    50
    a pulled menu when clicked. Entries may be empty (i.e. have no menu)
claus
parents: 119
diff changeset
    51
    and empty entries may (optionally) also perform some action when clicked.
claus
parents: 119
diff changeset
    52
    An entries selector is used as the key to define and access submenus
claus
parents: 119
diff changeset
    53
    and (for empty entries:) the selector sent to the receiver of the menu.
claus
parents: 119
diff changeset
    54
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    55
    Instance variables:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    56
128
claus
parents: 119
diff changeset
    57
      menus                   <Collection>    the sub menus
claus
parents: 119
diff changeset
    58
claus
parents: 119
diff changeset
    59
      titles                  <Collection>    the strings in the menu
claus
parents: 119
diff changeset
    60
claus
parents: 119
diff changeset
    61
      selectors               <Collection>    the selectors to send to the menu-
claus
parents: 119
diff changeset
    62
					      receiver (for empty pull-menus)
claus
parents: 119
diff changeset
    63
					      if nil (the default), title entries
claus
parents: 119
diff changeset
    64
					      do not send anything.
claus
parents: 119
diff changeset
    65
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    66
      activeMenuNumber        <Number>        the index of the currently active menu
128
claus
parents: 119
diff changeset
    67
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    68
      showSeparatingLines     <Boolean>       show separating lines between my menu-strings
128
claus
parents: 119
diff changeset
    69
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    70
      topMargin               <Number>        number of pixels at top
128
claus
parents: 119
diff changeset
    71
claus
parents: 119
diff changeset
    72
      fgColor                 <Color>         fg color to draw passive menu-titles
claus
parents: 119
diff changeset
    73
      bgColor                 <Color>         bg color to draw passive menu-titles
claus
parents: 119
diff changeset
    74
claus
parents: 119
diff changeset
    75
      activeFgColor           <Color>         fg color to draw activated menu-titles
claus
parents: 119
diff changeset
    76
      activeBgColor           <Color>         bg color to draw activated menu-titles
claus
parents: 119
diff changeset
    77
claus
parents: 119
diff changeset
    78
      onLevel                 <Integer>       3D level of entry-buttons when pressed
claus
parents: 119
diff changeset
    79
      offLevel                <Integer>       3D level of entry-buttons when released
claus
parents: 119
diff changeset
    80
claus
parents: 119
diff changeset
    81
      edgeStyle               <Symbol>        how to draw edges
claus
parents: 119
diff changeset
    82
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    83
      keepmenu                <Boolean>       if on, pulled menu stays on click,
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    84
					      till clicked again (motif & windows behavior)
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
    85
128
claus
parents: 119
diff changeset
    86
      toggleKeep              <Boolean>       if on and keepMenu is on,
claus
parents: 119
diff changeset
    87
					      clicking again on label closes menu
claus
parents: 119
diff changeset
    88
claus
parents: 119
diff changeset
    89
     except menus, titles and selectors, instvars are usually defined from
claus
parents: 119
diff changeset
    90
     defaults in the styleSheet; you should not care for them.
claus
parents: 119
diff changeset
    91
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
    92
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
    93
    StyleSheet values:
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
    94
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    95
      pullDownMenuViewBackground              view background Color for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    96
					      default: menuViewBackground
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    97
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    98
      pullDownMenuForegroundColor             foreground drawing color for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    99
					      default: menuForegroundColor
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   100
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   101
      pullDownMenuBackgroundColor             background drawing color for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   102
					      default: menuBackgroundColor
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   103
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   104
      pullDownMenuHilightForegroundColor      active foreground drawing color for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   105
					      default: menuHilightForegroundColor
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   106
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   107
      pullDownMenuHilightBackgroundColor      active background drawing color for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   108
					      default: menuHilightBackgroundColor
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   109
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   110
      pullDownMenuHilightLevel                level (3D only) when active
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   111
					      default: menuHilightLevel
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   112
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   113
      pullDownMenuEdgeStyle                   edge style (nil or #soft)
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   114
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   115
      pullDownMenuKeepMenu                    if true, pulled menu stays open until button
128
claus
parents: 119
diff changeset
   116
					      is pressed again outside of the item-area (motif behavior)
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   117
					      if false, menu closes on release (default)
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   118
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   119
      pullDownMenuToggleKeep                  if true, pulled menu closes when an entry is pressed
128
claus
parents: 119
diff changeset
   120
					      again. Otherwise, only press outside of the items area
claus
parents: 119
diff changeset
   121
					      hides it. default is false
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   122
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   123
      pullDownMenuLevel                       level (3D only)
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   124
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   125
      pullDownMenuFont                        font to use for the menu bar
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   126
					      default: menuFont
128
claus
parents: 119
diff changeset
   127
claus
parents: 119
diff changeset
   128
      pullDownMenuShowSeparatingLines         if true, lines are drawn between items.
claus
parents: 119
diff changeset
   129
					      default: false
133
claus
parents: 131
diff changeset
   130
claus
parents: 131
diff changeset
   131
      pullDownMenuRaiseTop                    if true, topview is raised whenever an entry
claus
parents: 131
diff changeset
   132
					      is activated.
claus
parents: 131
diff changeset
   133
					      default: true
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   134
"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   135
!
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   136
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   137
examples 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   138
"
128
claus
parents: 119
diff changeset
   139
	|top menu|
claus
parents: 119
diff changeset
   140
claus
parents: 119
diff changeset
   141
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   142
	top extent:300@300.
claus
parents: 119
diff changeset
   143
claus
parents: 119
diff changeset
   144
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
claus
parents: 119
diff changeset
   145
	menu labels:#('foo' 'bar').
claus
parents: 119
diff changeset
   146
	menu selectors:#(foo bar).
claus
parents: 119
diff changeset
   147
	menu at:#foo
claus
parents: 119
diff changeset
   148
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   149
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   150
	     receiver:nil.
claus
parents: 119
diff changeset
   151
	menu at:#bar 
claus
parents: 119
diff changeset
   152
	     putLabels:#('bar1' 'bar2' 'bar3')
claus
parents: 119
diff changeset
   153
	     selectors:#(bar1 bar2 bar3)
claus
parents: 119
diff changeset
   154
	     receiver:nil.
claus
parents: 119
diff changeset
   155
	top open
claus
parents: 119
diff changeset
   156
claus
parents: 119
diff changeset
   157
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   158
128
claus
parents: 119
diff changeset
   159
    empty entries are possible as selectable items (with non-nil seletor) ...
claus
parents: 119
diff changeset
   160
claus
parents: 119
diff changeset
   161
	|top menu|
claus
parents: 119
diff changeset
   162
claus
parents: 119
diff changeset
   163
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   164
	top extent:300@300.
claus
parents: 119
diff changeset
   165
claus
parents: 119
diff changeset
   166
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
claus
parents: 119
diff changeset
   167
	menu labels:#('foo' 'bar' 'baz').
claus
parents: 119
diff changeset
   168
	menu selectors:#(foo bar baz).
claus
parents: 119
diff changeset
   169
	menu at:#foo
claus
parents: 119
diff changeset
   170
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   171
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   172
	     receiver:nil.
claus
parents: 119
diff changeset
   173
	menu at:#baz 
claus
parents: 119
diff changeset
   174
	     putLabels:#('baz1' 'baz2' 'baz3')
claus
parents: 119
diff changeset
   175
	     selectors:#(baz1 baz2 baz3)
claus
parents: 119
diff changeset
   176
	     receiver:nil.
claus
parents: 119
diff changeset
   177
	top open
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   178
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   179
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   180
128
claus
parents: 119
diff changeset
   181
    ... or as separators (with nil selector)
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   182
128
claus
parents: 119
diff changeset
   183
	|top menu|
claus
parents: 119
diff changeset
   184
claus
parents: 119
diff changeset
   185
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   186
	top extent:500@200.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   187
128
claus
parents: 119
diff changeset
   188
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
claus
parents: 119
diff changeset
   189
	menu labels:#('foo' '    ' 'bar' ' baz' '    ' 'moreFoo' 'moreBar' 'moreBaz').
claus
parents: 119
diff changeset
   190
	menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
claus
parents: 119
diff changeset
   191
	menu at:#foo
claus
parents: 119
diff changeset
   192
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   193
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   194
	     receiver:nil.
claus
parents: 119
diff changeset
   195
	menu at:#bar 
claus
parents: 119
diff changeset
   196
	     putLabels:#('bar1' 'bar2' 'bar3')
claus
parents: 119
diff changeset
   197
	     selectors:#(bar1 bar2 bar3)
claus
parents: 119
diff changeset
   198
	     receiver:nil.
claus
parents: 119
diff changeset
   199
	menu at:#baz 
claus
parents: 119
diff changeset
   200
	     putLabels:#('baz1' 'baz2' 'baz3')
claus
parents: 119
diff changeset
   201
	     selectors:#(baz1 baz2 baz3)
claus
parents: 119
diff changeset
   202
	     receiver:nil.
claus
parents: 119
diff changeset
   203
	top open
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   204
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   205
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   206
128
claus
parents: 119
diff changeset
   207
claus
parents: 119
diff changeset
   208
    use the menus default height
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   209
128
claus
parents: 119
diff changeset
   210
	|top menu|
claus
parents: 119
diff changeset
   211
claus
parents: 119
diff changeset
   212
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   213
	top extent:300@300.
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   214
128
claus
parents: 119
diff changeset
   215
	menu := PullDownMenu in:top.
claus
parents: 119
diff changeset
   216
	menu origin:0.0@0.0 corner:1.0@(menu height).
claus
parents: 119
diff changeset
   217
	menu labels:#('foo' 'bar').
claus
parents: 119
diff changeset
   218
	menu selectors:#(foo bar).
claus
parents: 119
diff changeset
   219
	menu at:#foo
claus
parents: 119
diff changeset
   220
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   221
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   222
	     receiver:nil.
claus
parents: 119
diff changeset
   223
	top open
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   224
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   225
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   226
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   227
128
claus
parents: 119
diff changeset
   228
    although you can change the font, colors etc (as shown below)
claus
parents: 119
diff changeset
   229
    you should NOT do it - since if you do so, the styleSheet settings
claus
parents: 119
diff changeset
   230
    are ineffective (which users wont like probably)
claus
parents: 119
diff changeset
   231
    BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
claus
parents: 119
diff changeset
   232
	 pullDownMenuBackgroundColor and pullDownMenuFont
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   233
128
claus
parents: 119
diff changeset
   234
	|top menu|
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   235
128
claus
parents: 119
diff changeset
   236
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   237
	menu := PullDownMenu in:top.
claus
parents: 119
diff changeset
   238
	menu font:(Font family:'courier' size:20).
claus
parents: 119
diff changeset
   239
	menu foregroundColor:Color red.
claus
parents: 119
diff changeset
   240
	menu backgroundColor:Color yellow.
claus
parents: 119
diff changeset
   241
	menu viewBackground:Color yellow.
claus
parents: 119
diff changeset
   242
	menu showSeparatingLines:true.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   243
128
claus
parents: 119
diff changeset
   244
	menu origin:0.0@0.0 corner:1.0@(menu height).
claus
parents: 119
diff changeset
   245
	menu labels:#('foo' 'bar').
claus
parents: 119
diff changeset
   246
	menu selectors:#(foo bar).
claus
parents: 119
diff changeset
   247
	menu at:#foo
claus
parents: 119
diff changeset
   248
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   249
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   250
	     receiver:nil.
claus
parents: 119
diff changeset
   251
	(menu menuAt:#foo) font:(Font family:'courier' size:36).
claus
parents: 119
diff changeset
   252
	top open
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   253
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   254
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   255
128
claus
parents: 119
diff changeset
   256
    you can use icons, too ...
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   257
128
claus
parents: 119
diff changeset
   258
	|labels top menu|
claus
parents: 119
diff changeset
   259
claus
parents: 119
diff changeset
   260
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   261
	top extent:300@300.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   262
128
claus
parents: 119
diff changeset
   263
	menu := PullDownMenu in:top.
claus
parents: 119
diff changeset
   264
	menu origin:0.0@0.0 corner:1.0@(menu height).
claus
parents: 119
diff changeset
   265
	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
claus
parents: 119
diff changeset
   266
			with:'foo'
claus
parents: 119
diff changeset
   267
			with:'bar'.
claus
parents: 119
diff changeset
   268
	menu labels:labels.
claus
parents: 119
diff changeset
   269
	menu selectors:#(about foo bar).
claus
parents: 119
diff changeset
   270
	menu at:#about 
claus
parents: 119
diff changeset
   271
	     putLabels:#('about PullDownMenus')
claus
parents: 119
diff changeset
   272
	     selectors:#(aboutMenus)
claus
parents: 119
diff changeset
   273
	     receiver:nil.
claus
parents: 119
diff changeset
   274
	menu at:#foo
claus
parents: 119
diff changeset
   275
	     putLabels:#('foo1' 'foo2' 'foo3')
claus
parents: 119
diff changeset
   276
	     selectors:#(foo1 foo2 foo3)
claus
parents: 119
diff changeset
   277
	     receiver:nil.
claus
parents: 119
diff changeset
   278
	top open
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   279
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   280
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   281
128
claus
parents: 119
diff changeset
   282
    a concrete example (combining things described above)
claus
parents: 119
diff changeset
   283
    (using a Plug, since we have no application class here):
claus
parents: 119
diff changeset
   284
claus
parents: 119
diff changeset
   285
	|labels top menu textView appModel|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   286
128
claus
parents: 119
diff changeset
   287
	appModel := Plug new.
claus
parents: 119
diff changeset
   288
	appModel respondTo:#quit with:[top destroy].
claus
parents: 119
diff changeset
   289
	appModel respondTo:#showAbout with:[self information:'some info here ...'].
claus
parents: 119
diff changeset
   290
	appModel respondTo:#help with:[self information:'some help here ...'].
claus
parents: 119
diff changeset
   291
claus
parents: 119
diff changeset
   292
	top := StandardSystemView new.
claus
parents: 119
diff changeset
   293
	top extent:300@300.
claus
parents: 119
diff changeset
   294
claus
parents: 119
diff changeset
   295
	menu := PullDownMenu in:top.
claus
parents: 119
diff changeset
   296
	menu receiver:appModel.
claus
parents: 119
diff changeset
   297
	menu origin:0.0@0.0 corner:1.0@(menu height).
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   298
128
claus
parents: 119
diff changeset
   299
	textView := ScrollableView forView:(EditTextView new).
claus
parents: 119
diff changeset
   300
	textView origin:0.0@menu height corner:1.0@1.0.
claus
parents: 119
diff changeset
   301
	top addSubView:textView.
claus
parents: 119
diff changeset
   302
claus
parents: 119
diff changeset
   303
	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
claus
parents: 119
diff changeset
   304
			with:'file'
claus
parents: 119
diff changeset
   305
			with:'edit'
claus
parents: 119
diff changeset
   306
			with:'help'.
claus
parents: 119
diff changeset
   307
	menu labels:labels.
claus
parents: 119
diff changeset
   308
	menu selectors:#(about file edit help).
claus
parents: 119
diff changeset
   309
	menu at:#about 
claus
parents: 119
diff changeset
   310
	     putLabels:#('about PullDownMenus')
claus
parents: 119
diff changeset
   311
	     selectors:#(showAbout)
claus
parents: 119
diff changeset
   312
	     receiver:appModel.
claus
parents: 119
diff changeset
   313
	menu at:#file 
claus
parents: 119
diff changeset
   314
	     putLabels:#('quit')
claus
parents: 119
diff changeset
   315
	     selectors:#(quit)
claus
parents: 119
diff changeset
   316
	     receiver:appModel.
claus
parents: 119
diff changeset
   317
	menu at:#edit 
claus
parents: 119
diff changeset
   318
	     putLabels:#('copy' 'cut' 'paste')
claus
parents: 119
diff changeset
   319
	     selectors:#(copySelection cut paste)
claus
parents: 119
diff changeset
   320
	     receiver:textView.
claus
parents: 119
diff changeset
   321
	top open
3
claus
parents: 0
diff changeset
   322
"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   323
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   324
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   325
!PullDownMenu class methodsFor:'instance creation'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   326
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   327
labels:titleArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   328
    "create and return a new PullDownMenu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   329
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   330
    ^ self new labels:titleArray
3
claus
parents: 0
diff changeset
   331
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   332
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   333
!PullDownMenu class methodsFor:'defaults'!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   334
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   335
updateStyleCache
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   336
    "extract values from the styleSheet and cache them in class variables"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   337
133
claus
parents: 131
diff changeset
   338
    |styleSheet|
claus
parents: 131
diff changeset
   339
claus
parents: 131
diff changeset
   340
    styleSheet := StyleSheet.
claus
parents: 131
diff changeset
   341
claus
parents: 131
diff changeset
   342
    DefaultViewBackground := styleSheet colorAt:'pullDownMenuViewBackground'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   343
    DefaultViewBackground isNil ifTrue:[
133
claus
parents: 131
diff changeset
   344
	DefaultViewBackground := styleSheet colorAt:'menuViewBackground'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   345
    ].
133
claus
parents: 131
diff changeset
   346
    DefaultForegroundColor := styleSheet colorAt:'pullDownMenuForegroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   347
    DefaultForegroundColor isNil ifTrue:[
133
claus
parents: 131
diff changeset
   348
	DefaultForegroundColor := styleSheet colorAt:'menuForegroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   349
    ].
133
claus
parents: 131
diff changeset
   350
    DefaultBackgroundColor := styleSheet colorAt:'pullDownMenuBackgroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   351
    DefaultBackgroundColor isNil ifTrue:[
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   352
	DefaultViewBackground notNil ifTrue:[
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   353
	    DefaultBackgroundColor := DefaultViewBackground
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   354
	] ifFalse:[
133
claus
parents: 131
diff changeset
   355
	    DefaultBackgroundColor := styleSheet colorAt:'menuBackgroundColor'.
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   356
	]
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   357
    ].
133
claus
parents: 131
diff changeset
   358
    DefaultHilightForegroundColor := styleSheet colorAt:'pullDownMenuHilightForegroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   359
    DefaultHilightForegroundColor isNil ifTrue:[
133
claus
parents: 131
diff changeset
   360
	DefaultHilightForegroundColor := styleSheet colorAt:'menuHilightForegroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   361
    ].
133
claus
parents: 131
diff changeset
   362
    DefaultHilightBackgroundColor := styleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   363
    DefaultHilightBackgroundColor isNil ifTrue:[
133
claus
parents: 131
diff changeset
   364
	DefaultHilightBackgroundColor := styleSheet colorAt:'menuHilightBackgroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   365
    ].
133
claus
parents: 131
diff changeset
   366
    DefaultHilightLevel := styleSheet at:'pullDownMenuHilightLevel'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   367
    DefaultHilightLevel isNil ifTrue:[
133
claus
parents: 131
diff changeset
   368
	DefaultHilightLevel := styleSheet at:'menuHilightLevel' default:0.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   369
    ].
133
claus
parents: 131
diff changeset
   370
    DefaultEdgeStyle := styleSheet at:'pullDownMenuEdgeStyle'.
claus
parents: 131
diff changeset
   371
    DefaultKeepMenu := styleSheet at:'pullDownMenuKeepMenu' default:false.
claus
parents: 131
diff changeset
   372
    DefaultToggleKeep := styleSheet at:'pullDownMenuToggleKeep' default:false.
claus
parents: 131
diff changeset
   373
    DefaultLevel := styleSheet at:'pullDownMenuLevel' default:1.
claus
parents: 131
diff changeset
   374
    DefaultFont := styleSheet fontAt:'pullDownMenuFont'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   375
    DefaultFont isNil ifTrue:[
133
claus
parents: 131
diff changeset
   376
	DefaultFont := styleSheet fontAt:'menuFont'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   377
    ].
133
claus
parents: 131
diff changeset
   378
    DefaultSeparatingLines := styleSheet at:'pullDownMenuSeparatingLines' default:false.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   379
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   380
    "
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   381
     PullDownMenu updateStyleCache
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   382
    "
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   383
! !
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   384
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   385
!PullDownMenu methodsFor:'accessing'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   386
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   387
add:label selector:selector
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   388
        "add a new title-item at the end.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   389
         The corresponding label can later be set with #at:putMenu:
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   390
         or #at:putLabels:selectors:..."
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   391
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   392
        self add:label selector:selector after:nil
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   393
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   394
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   395
add:label selector:selector after:indexOrString
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   396
        "add a new title-item after an existing item, indexOrString,
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   397
         or at the end if the after-arg is nil.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   398
         The corresponding label can later be set with #at:putMenu:
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   399
         or #at:putLabels:selectors:..."
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   400
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   401
        |idx|
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   402
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   403
        indexOrString isNil ifTrue:[
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   404
            idx := titles size
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   405
        ] ifFalse:[
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   406
            idx := self indexOf:indexOrString.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   407
        ].
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   408
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   409
        titles isNil ifTrue:[
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   410
            menus := Array with:nil.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   411
            titles := Array with:label.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   412
            selectors := Array with:nil.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   413
        ] ifFalse:[
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   414
            menus := (menus copyTo:idx) , #(nil) , (menus copyFrom:idx+1).
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   415
            titles := ((titles copyTo:idx) copyWith:label) , (titles copyFrom:idx+1).
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   416
            selectors := ((selectors copyTo:idx) copyWith:selector) , (selectors copyFrom:idx+1).
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   417
        ].
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   418
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   419
        "
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   420
         |top m|
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   421
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   422
         top := StandardSystemView new.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   423
         m := PullDownMenu in:top.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   424
         m labels:#('file' 'edit').
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   425
         m selectors:#(file #edit).
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   426
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   427
         m add:'help' selector:#help after:#file.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   428
         m at:#help putMenu:(MenuView labels:#('foo' 'bar')
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   429
                                   selectors:#(foo bar)
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   430
                                    receiver:nil).
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   431
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   432
         top open
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   433
        "
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   434
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   435
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   436
at:aString putLabels:labels selector:selector args:args receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   437
    "create and set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   438
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   439
    |menuView|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   440
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   441
    menuView := MenuView labels:labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   442
		       selector:selector
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   443
			   args:args
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   444
		       receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   445
			    for:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   446
    self at:aString putMenu:menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   447
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   448
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   449
at:aString putLabels:labels selectors:selectors args:args receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   450
    "create and set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   451
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   452
    |menuView|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   453
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   454
    menuView := MenuView labels:labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   455
		      selectors:selectors
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   456
			   args:args
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   457
		       receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   458
			    for:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   459
    self at:aString putMenu:menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   460
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   461
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   462
at:aString putLabels:labels selectors:selectors receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   463
    "create and set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   464
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   465
    |menuView|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   466
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   467
    menuView := MenuView labels:labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   468
		      selectors:selectors
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   469
		       receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   470
			    for:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   471
    self at:aString putMenu:menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   472
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   473
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   474
at:aString putMenu:aMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   475
    "set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   476
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   477
    |index|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   478
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   479
    index := self indexOf:aString.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   480
    (index == 0) ifTrue:[
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   481
        self error:'no such menu entry'.
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   482
        ^ nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   483
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   484
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   485
"/ not needed:
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   486
"/    aMenu origin:((left + (self titleLenUpTo:index)) 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   487
"/                  @
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   488
"/                  (height + aMenu borderWidth)).
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   489
    aMenu superView:(self superView).
291
71f4a66b3281 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 289
diff changeset
   490
    aMenu beInvisible.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   491
    menus at:index put:aMenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   492
    aMenu masterView:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   493
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   494
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   495
labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   496
    "return the menu-titles (group-headers)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   497
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   498
    ^ titles
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   499
!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   500
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   501
labels:titleArray
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   502
    "define the menu-titles (group-headers)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   503
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   504
    |numberOfLabels|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   505
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   506
    numberOfLabels := titleArray size.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   507
    menus := Array new:numberOfLabels.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   508
    titles := Array new:numberOfLabels.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   509
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   510
    titleArray keysAndValuesDo:[:index :entry |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   511
	|e|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   512
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   513
	entry isImage ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   514
	    e := entry on:device
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   515
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   516
	    e := entry printString
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   517
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   518
	titles at:index put:e
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   519
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   520
    shown ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   521
	self clear.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   522
	self redraw
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   523
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   524
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   525
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   526
labels:titleArray selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   527
    "define the menu-titles (group-headers) and selectors.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   528
     Selectors are mostly used as access keys to get to submenus later."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   529
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   530
    self labels:titleArray.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   531
    self selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   532
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   533
    "Created: 20.10.1995 / 20:15:54 / cg"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   534
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   535
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   536
menuAt:stringOrNumber
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   537
    "return the menu with the title; return nil if not found"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   538
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   539
    |index|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   540
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   541
    index := self indexOf:stringOrNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   542
    (index == 0) ifTrue:[^ nil].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   543
    ^ menus at:index
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   544
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   545
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   546
numberOfTitles:n
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   547
    "setup blank title-space to be filled in later"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   548
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   549
    menus := Array new:n.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   550
    titles := Array new:n
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   551
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   552
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   553
receiver:anObject 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   554
    "set the menu-receiver. Thats the one who gets the
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   555
     messages (both from myself and from my submenus).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   556
     This only sets the receiver for menus which are already
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   557
     created - menus added later should get their receiver in
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   558
     the creation send."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   559
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   560
    receiver := anObject.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   561
    menus notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   562
	menus do:[:aMenu |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   563
	    aMenu notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   564
		aMenu receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   565
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   566
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   567
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   568
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   569
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   570
selectors
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   571
    "return the menu-selectors"
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   572
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   573
    ^ selectors
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   574
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   575
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   576
selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   577
    "define the menu-selectors. These are used as accesskey only
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   578
     in menuAt: accesses. This makes PullDownMenu accesss
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   579
     somewhat more compatible to PopUpMenus."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   580
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   581
    selectors := selectorArray.
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   582
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   583
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   584
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   585
!PullDownMenu methodsFor:'accessing-look'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   586
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   587
backgroundColor:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   588
    "set the background drawing color.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   589
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   590
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   591
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   592
    bgColor := aColor on:device
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   593
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   594
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   595
font:aFont
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   596
    "set the menus font.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   597
     adjusts menu-origins when font changes.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   598
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   599
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   600
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   601
    aFont ~~ font ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   602
	super font:(aFont on:device).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   603
	self height:(font height + (font descent * 2)).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   604
	shown ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   605
	    self setMenuOrigins
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   606
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   607
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   608
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   609
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   610
foregroundColor:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   611
    "set the foreground drawing color.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   612
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   613
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   614
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   615
    fgColor := aColor on:device
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   616
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   617
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   618
showSeparatingLines:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   619
    "turn on/off drawing of separating lines.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   620
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   621
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   622
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   623
    showSeparatingLines := aBoolean.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   624
    shown ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   625
	self setMenuOrigins.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   626
	self redraw
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   627
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   628
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   629
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   630
!PullDownMenu methodsFor:'drawing '!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   631
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   632
drawActiveTitleSelected:selected
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   633
    |x|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   634
    activeMenuNumber notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   635
	x := self titleLenUpTo:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   636
	self drawTitle:(titles at:activeMenuNumber) x:x selected:selected 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   637
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   638
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   639
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   640
drawTitle:stringOrImage x:x0 selected:selected
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   641
    |y w x wSpace fg bg map|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   642
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   643
    selected ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   644
	fg := activeFgColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   645
	bg := activeBgColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   646
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   647
	fg := fgColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   648
	bg := bgColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   649
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   650
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   651
    wSpace := font widthOf:' '.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   652
    x := x0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   653
    stringOrImage isString ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   654
	y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   655
	w := font widthOf:stringOrImage.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   656
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   657
	y := ((height - stringOrImage height) // 2) max:0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   658
	w := stringOrImage width
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   659
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   660
    w := w + (wSpace * 2).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   661
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   662
    self paint:bg.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   663
    self fillRectangleX:x y:0 width:w height:height.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   664
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   665
    self is3D ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   666
	self drawEdgesForX:x y:0
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   667
		     width:w
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   668
		    height:height
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   669
		     level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   670
    ].
250
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
   671
    self paint:fg on:bg.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   672
    x := x + wSpace.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   673
    stringOrImage isString ifTrue:[
250
77012e65ac84 draw strings as opaque strings - OS/2 server has a bug with non-image strings
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
   674
	self displayOpaqueString:stringOrImage x:x y:y
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   675
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   676
	stringOrImage isImageOrForm ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   677
	    stringOrImage depth == 1 ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   678
		(map := stringOrImage colorMap) notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   679
		    self paint:(map at:2) on:(map at:1).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   680
		    self displayOpaqueForm:stringOrImage x:x y:y.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   681
		    ^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   682
		]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   683
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   684
	    self displayForm:stringOrImage x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   685
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   686
	    stringOrImage displayOn:self x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   687
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   688
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   689
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   690
    "Modified: 20.10.1995 / 22:03:27 / cg"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   691
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   692
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   693
highlightActiveTitle
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   694
    self drawActiveTitleSelected:true 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   695
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   696
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   697
redraw
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   698
    |x     "{ Class: SmallInteger }"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   699
     y     "{ Class: SmallInteger }"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   700
     index "{ Class: SmallInteger }" 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   701
     wSpace clr|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   702
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   703
    shown ifFalse: [ ^ self ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   704
    titles isNil ifTrue:[^ self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   705
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   706
    wSpace := (font widthOf:' ').
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   707
    x := 0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   708
    y := height "- 1".
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   709
    index := 1.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   710
    titles do:[:title |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   711
	self drawTitle:title x:x selected:(index == activeMenuNumber).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   712
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   713
	title isString ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   714
	    x := x + (font widthOf:title).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   715
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   716
	    x := x + title width
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   717
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   718
	x := x + wSpace + wSpace.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   719
	showSeparatingLines ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   720
	    self is3D ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   721
		self paint:shadowColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   722
		self displayLineFromX:x y:0 toX:x y:y.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   723
		x := x + 1.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   724
		clr := lightColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   725
	    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   726
		clr := fgColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   727
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   728
	    self paint:clr.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   729
	    self displayLineFromX:x y:0 toX:x y:y.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   730
	    x := x + 1
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   731
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   732
	index := index + 1
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   733
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   734
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   735
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   736
unHighlightActiveTitle
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   737
    self drawActiveTitleSelected:false 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   738
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   739
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   740
!PullDownMenu methodsFor:'event handling'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   741
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   742
buttonMotion:state x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   743
    |titleIndex activeMenu activeLeft activeTop|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   744
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   745
    state == 0 ifTrue:[^ self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   746
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   747
    activeMenuNumber notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   748
	activeMenu := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   749
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   750
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   751
    (y < height) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   752
	"moving around in title line"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   753
	activeMenu notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   754
	    activeMenu selection:nil
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   755
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   756
	titleIndex := self titleIndexForX:x.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   757
	titleIndex notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   758
	    (titleIndex ~~ activeMenuNumber) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   759
		self pullMenu:titleIndex
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   760
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   761
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   762
	    self hideActiveMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   763
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   764
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   765
	"moving around below"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   766
	activeMenu isNil ifTrue:[^self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   767
	activeLeft := activeMenu left.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   768
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   769
	    activeTop := activeMenu top.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   770
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   771
		"moving around in menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   772
		activeMenu buttonMotion:state
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   773
				      x:(x - activeLeft)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   774
				      y:(y - activeTop).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   775
		^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   776
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   777
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   778
	"moved outside menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   779
	activeMenu selection:nil
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   780
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   781
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   782
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   783
buttonPress:button x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   784
    |titleIndex activeMenu activeLeft activeTop m|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   785
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   786
    device ungrabPointer.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   787
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   788
    (y between:0 and:height) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   789
	titleIndex := self titleIndexForX:x.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   790
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   791
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   792
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   793
     now, titleIndex is non-nil if pressed within myself
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   794
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   795
    (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   796
	m := self pullMenu:titleIndex.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   797
	(keepMenu and:[m notNil]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   798
	    device grabPointerInView:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   799
	    self cursor:Cursor upRightArrow
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   800
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   801
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   802
	(keepMenu and:[toggleKeep not]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   803
	    titleIndex == activeMenuNumber ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   804
		"same pressed again ... stay"
289
82d20a3e2fe8 dont grab if no menu pulled
Claus Gittinger <cg@exept.de>
parents: 283
diff changeset
   805
		titleIndex notNil ifTrue:[
82d20a3e2fe8 dont grab if no menu pulled
Claus Gittinger <cg@exept.de>
parents: 283
diff changeset
   806
		    device grabPointerInView:self.
82d20a3e2fe8 dont grab if no menu pulled
Claus Gittinger <cg@exept.de>
parents: 283
diff changeset
   807
		].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   808
		^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   809
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   810
	    "moving around below"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   811
	    activeMenuNumber isNil ifTrue:[^self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   812
	    activeMenu := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   813
	    activeLeft := activeMenu left.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   814
	    (x between:activeLeft and:(activeMenu right)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   815
		activeTop := activeMenu top.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   816
		(y between:activeTop and:(activeMenu bottom)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   817
		    "moving around in menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   818
		    activeMenu buttonPress:button
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   819
					 x:(x - activeLeft)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   820
					 y:(y - activeTop).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   821
		    ^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   822
		]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   823
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   824
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   825
	self hideActiveMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   826
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   827
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   828
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   829
buttonRelease:button x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   830
    |activeMenu activeLeft activeTop hideMenu sel|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   831
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   832
    activeMenuNumber isNil ifTrue:[^self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   833
    activeMenu := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   834
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   835
    hideMenu := false.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   836
    (y >= height) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   837
	"release below title-line"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   838
	activeLeft := activeMenu left.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   839
	"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   840
	 released in a submenu ?
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   841
	"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   842
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   843
	    activeTop := activeMenu top.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   844
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   845
		"release in menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   846
		self hideActiveMenu.   
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   847
		activeMenu buttonRelease:button
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   848
				       x:(x - activeLeft)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   849
				       y:(y - activeTop).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   850
		^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   851
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   852
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   853
	hideMenu := true.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   854
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   855
	y < 0 ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   856
	    hideMenu := true
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   857
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   858
	    activeMenu isNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   859
		selectors notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   860
		    sel := selectors at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   861
		    sel notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   862
			receiver perform:sel
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   863
		    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   864
		].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   865
		hideMenu := true.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   866
	    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   867
		keepMenu ifFalse:[   
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   868
		    hideMenu := true
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   869
		]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   870
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   871
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   872
    ].                  
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   873
    hideMenu ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   874
       self hideActiveMenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   875
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   876
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   877
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   878
keyPress:key x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   879
    <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect)>
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   880
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   881
    |index m sel|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   882
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   883
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   884
     handle CursorLeft/Right for non-mouse operation
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   885
     (for example, if it has the explicit focus)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   886
     These will pull the previous/next menu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   887
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   888
    ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   889
	activeMenuNumber isNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   890
	    index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   891
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   892
	    (key == #CursorRight) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   893
		index := activeMenuNumber+1
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   894
	    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   895
		index := activeMenuNumber-1
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   896
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   897
	    index == 0 ifTrue:[index := menus size]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   898
	    ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   899
		index > menus size ifTrue:[index := 1]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   900
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   901
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   902
	self pullMenu:index.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   903
	^ self
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   904
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   905
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   906
    activeMenuNumber isNil ifTrue:[^self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   907
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   908
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   909
     Return, space or the (virtual) MenuSelect key trigger
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   910
     a menu entry (for non-submenu entries).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   911
     Otherwise, if we have a submenu open,
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   912
     pass the key on to it ...
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   913
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   914
    m := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   915
    m isNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   916
	(key == #Return 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   917
	or:[key == #MenuSelect
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   918
	or:[key == Character space]]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   919
	    sel := selectors at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   920
	    sel notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   921
		receiver perform:sel
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   922
	    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   923
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   924
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   925
	m keyPress:key x:0 y:0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   926
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   927
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   928
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   929
showNoFocus
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   930
    "when stepping focus, hide any active menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   931
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   932
    self hideActiveMenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   933
    super showNoFocus
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   934
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   935
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   936
!PullDownMenu methodsFor:'hiding/showing menus'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   937
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   938
hideActiveMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   939
    "hide currently active menu - release grab if there is any grab (keepMenu)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   940
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   941
    ^ self hideActiveMenuRelease:true
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   942
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   943
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   944
hideActiveMenuRelease:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   945
    "hide currently active menu - release grab if aBoolean is true
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   946
     and a grab was set (keepMenu)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   947
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   948
    |m|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   949
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   950
    activeMenuNumber notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   951
	(m := menus at:activeMenuNumber) notNil ifTrue:[
291
71f4a66b3281 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 289
diff changeset
   952
	    m beInvisible.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   953
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   954
	self unHighlightActiveTitle.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   955
	activeMenuNumber := nil
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   956
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   957
    aBoolean ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   958
	device ungrabPointer. 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   959
	self cursor:Cursor normal
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   960
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   961
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   962
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   963
pullMenu:aNumber
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   964
    "activate a menu, return it or nil"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   965
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   966
    |subMenu r posY|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   967
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   968
    activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   969
    activeMenuNumber := aNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   970
    subMenu := menus at:aNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   971
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   972
    raiseTopWhenActivated ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   973
	self topView raise.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   974
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   975
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   976
    (activeMenuNumber notNil 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   977
    and:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   978
	 subMenu notNil
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   979
	 or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   980
	    self highlightActiveTitle.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   981
	 ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   982
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   983
    subMenu notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   984
	subMenu origin:((left + (self titleLenUpTo:aNumber)) 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   985
		       @
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   986
		       (posY := height + subMenu borderWidth)).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   987
	subMenu hiddenOnRealize:false.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   988
	subMenu deselect.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   989
	subMenu create.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   990
	subMenu saveUnder:true.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   991
	subMenu superMenu:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   992
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   993
	subMenu right > (r := self right) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   994
	    subMenu origin:((r - subMenu width) @ posY).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   995
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   996
	subMenu raise show.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   997
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   998
    ^ subMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   999
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1000
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1001
regainControl
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1002
    keepMenu ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1003
	device grabPointerInView:self.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1004
	self cursor:Cursor upRightArrow
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1005
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1006
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1007
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1008
!PullDownMenu methodsFor:'initialize / release'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1009
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1010
create
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1011
    super create.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1012
    self setMenuOrigins
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1013
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1014
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1015
destroy
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1016
    "have to destroy the menus manually here,
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1017
     since they are no real subviews of myself"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1018
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1019
    menus notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1020
	menus do:[:m |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1021
	    m notNil ifTrue:[m destroy]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1022
	].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1023
	menus := nil
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1024
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1025
    activeMenuNumber := nil.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1026
    super destroy.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1027
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1028
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1029
initCursor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1030
    "set up a hand cursor"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1031
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1032
    cursor := Cursor hand
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1033
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1034
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1035
initStyle
130
claus
parents: 128
diff changeset
  1036
    |style|
claus
parents: 128
diff changeset
  1037
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1038
    super initStyle.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1039
128
claus
parents: 119
diff changeset
  1040
    showSeparatingLines := DefaultSeparatingLines. "/ false.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1041
    DefaultViewBackground notNil ifTrue:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1042
	viewBackground := DefaultViewBackground on:device
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1043
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1044
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1045
    DefaultFont notNil ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1046
	font := DefaultFont on:device
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1047
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1048
    DefaultForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1049
	fgColor := DefaultForegroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1050
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1051
	fgColor := Black.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1052
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1053
    DefaultBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1054
	bgColor := DefaultBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1055
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1056
	bgColor := viewBackground.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1057
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1058
    onLevel := DefaultHilightLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1059
    offLevel := DefaultLevel.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
  1060
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1061
    self is3D ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1062
	device hasColors ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1063
	    activeFgColor := Color name:'yellow'
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1064
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1065
	    activeFgColor := White
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1066
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1067
	device hasGreyscales ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1068
	    activeBgColor := bgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1069
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1070
	    activeBgColor := fgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1071
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1072
	topMargin := 2.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
  1073
130
claus
parents: 128
diff changeset
  1074
	style := styleSheet name.
claus
parents: 128
diff changeset
  1075
	((style == #iris) or:[style == #motif]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1076
	    self level:2.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1077
	    onLevel := 2.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1078
	    offLevel := 0.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1079
	    activeFgColor := fgColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1080
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1081
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1082
	activeFgColor := bgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1083
	activeBgColor := fgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1084
	topMargin := 0
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1085
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1086
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1087
    edgeStyle := DefaultEdgeStyle.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1088
    keepMenu := DefaultKeepMenu.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1089
    toggleKeep := DefaultToggleKeep.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1090
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1091
    DefaultHilightForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1092
	activeFgColor := DefaultHilightForegroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1093
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1094
    DefaultHilightBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1095
	activeBgColor := DefaultHilightBackgroundColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1096
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1097
    DefaultShadowColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1098
	shadowColor := DefaultShadowColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1099
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1100
    DefaultLightColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1101
	lightColor := DefaultLightColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1102
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1103
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1104
    bgColor := bgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1105
    fgColor := fgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1106
    activeBgColor := activeBgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1107
    activeFgColor := activeFgColor on:device.
133
claus
parents: 131
diff changeset
  1108
claus
parents: 131
diff changeset
  1109
    raiseTopWhenActivated := styleSheet at:'pullDownMenuRaiseTop' default:true.
claus
parents: 131
diff changeset
  1110
!
claus
parents: 131
diff changeset
  1111
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1112
initialize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1113
    super initialize.
133
claus
parents: 131
diff changeset
  1114
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1115
    font := font on:device.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1116
    self origin:(0.0 @ 0.0)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1117
	 extent:(1.0 @ self preferredExtent y)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1118
"/         extent:(1.0 @ (font height + (font descent * 2)  + topMargin)).
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1119
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1120
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1121
recreate
128
claus
parents: 119
diff changeset
  1122
    "if the image was saved with an active menu, hide it"
claus
parents: 119
diff changeset
  1123
claus
parents: 119
diff changeset
  1124
    |m|
115
claus
parents: 112
diff changeset
  1125
claus
parents: 112
diff changeset
  1126
    activeMenuNumber notNil ifTrue:[
128
claus
parents: 119
diff changeset
  1127
	(m := menus at:activeMenuNumber) notNil ifTrue:[
claus
parents: 119
diff changeset
  1128
	    m unrealize.
claus
parents: 119
diff changeset
  1129
	].
115
claus
parents: 112
diff changeset
  1130
	activeMenuNumber := nil.
claus
parents: 112
diff changeset
  1131
    ].
claus
parents: 112
diff changeset
  1132
    super recreate.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1133
    self setMenuOrigins
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1134
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1135
133
claus
parents: 131
diff changeset
  1136
superView:aView
claus
parents: 131
diff changeset
  1137
    "when my superView changes, all of my menus must change as well"
claus
parents: 131
diff changeset
  1138
claus
parents: 131
diff changeset
  1139
    super superView:aView.
claus
parents: 131
diff changeset
  1140
    menus notNil ifTrue:[
claus
parents: 131
diff changeset
  1141
	menus do:[:aMenu |
claus
parents: 131
diff changeset
  1142
	    aMenu notNil ifTrue:[
claus
parents: 131
diff changeset
  1143
		aMenu superView:aView
claus
parents: 131
diff changeset
  1144
	    ]
claus
parents: 131
diff changeset
  1145
	]
claus
parents: 131
diff changeset
  1146
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1147
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1148
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1149
!PullDownMenu methodsFor:'private'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1150
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1151
indexOf:stringOrNumber
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1152
    "return the index of the menu with title; return 0 if not found.
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1153
     stringOrNumber may be a number, a selector from the selectorArray
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1154
     or a string from the title array."
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1155
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1156
    |idx|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1157
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1158
    stringOrNumber isNumber ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1159
	^ stringOrNumber
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1160
    ].
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1161
    selectors notNil ifTrue:[
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1162
	idx := selectors indexOf:stringOrNumber.
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1163
	idx ~~ 0 ifTrue:[^ idx].
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1164
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1165
    ^ titles indexOf:stringOrNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1166
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1167
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1168
setMenuOrigins
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1169
    "adjust origins of menus when font changes"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1170
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1171
    (font device == device) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1172
	menus keysAndValuesDo:[:index :aMenu |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1173
	    aMenu notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1174
		aMenu origin:((left + (self titleLenUpTo:index)) 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1175
			      @
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1176
			      (height + aMenu borderWidth))
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1177
	    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1178
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1179
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1180
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1181
133
claus
parents: 131
diff changeset
  1182
someMenuItemLabeled:aLabel
claus
parents: 131
diff changeset
  1183
    "find a menu item.
claus
parents: 131
diff changeset
  1184
     Currently, in ST/X, instances of MenuItem are only created as dummy"
claus
parents: 131
diff changeset
  1185
claus
parents: 131
diff changeset
  1186
    |idx|
claus
parents: 131
diff changeset
  1187
claus
parents: 131
diff changeset
  1188
    idx := self indexOf:aLabel.
claus
parents: 131
diff changeset
  1189
    idx ~~ 0 ifTrue:[
claus
parents: 131
diff changeset
  1190
	^ MenuItem new menu:self index:idx
claus
parents: 131
diff changeset
  1191
    ].
claus
parents: 131
diff changeset
  1192
    menus notNil ifTrue:[
claus
parents: 131
diff changeset
  1193
	menus do:[:aMenu |
claus
parents: 131
diff changeset
  1194
	    |item|
claus
parents: 131
diff changeset
  1195
claus
parents: 131
diff changeset
  1196
	    aMenu notNil ifTrue:[
claus
parents: 131
diff changeset
  1197
		(item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
claus
parents: 131
diff changeset
  1198
		    ^ item
claus
parents: 131
diff changeset
  1199
		]
claus
parents: 131
diff changeset
  1200
	    ]
claus
parents: 131
diff changeset
  1201
	]
claus
parents: 131
diff changeset
  1202
    ].
claus
parents: 131
diff changeset
  1203
    ^ nil
claus
parents: 131
diff changeset
  1204
!
claus
parents: 131
diff changeset
  1205
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1206
titleIndexForX:x
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1207
    "given a click x-position, return index in title or nil"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1208
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1209
    |xstart "{ Class: SmallInteger }"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1210
     xend   "{ Class: SmallInteger }" 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1211
     wSpace wSep|
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1212
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1213
    wSpace := (font widthOf:' ') * 2. 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1214
    showSeparatingLines ifTrue:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1215
	self is3D ifTrue:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1216
	    wSep := 2
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1217
	] ifFalse:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1218
	    wSep := 1
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1219
	]
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1220
    ] ifFalse:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1221
	wSep := 0
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1222
    ].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1223
    xstart := 0.
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1224
    1 to:(titles size) do:[:index |
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1225
	|entry thisLength|
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1226
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1227
	entry := titles at:index.
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1228
	entry isString ifTrue:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1229
	    thisLength := font widthOf:entry.
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1230
	] ifFalse:[
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1231
	    thisLength := entry width
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1232
	].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1233
	xend := xstart + thisLength + wSpace + wSep.
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1234
	(x between:xstart and:xend) ifTrue:[^ index].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1235
	xstart := xend
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1236
    ].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1237
    ^ nil
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1238
!
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1239
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1240
titleLenUpTo:index
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1241
    "answer len (in pixels) of all title-strings up-to 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1242
     (but excluding) title-index. Used to compute x-position when drawing
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1243
     individual entries."
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1244
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1245
    |len "{ Class: SmallInteger }" 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1246
     wSpace wSep|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1247
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1248
    (index <= 1) ifTrue:[^ 0].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1249
    wSpace := (font widthOf:' ').
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1250
    showSeparatingLines ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1251
	self is3D ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1252
	    wSep := 2
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1253
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1254
	    wSep := 1
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1255
	]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1256
    ] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1257
	wSep := 0
133
claus
parents: 131
diff changeset
  1258
    ].
claus
parents: 131
diff changeset
  1259
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1260
    len := 0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1261
    titles from:1 to:(index - 1) do:[:entry |
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1262
	|thisLength|
128
claus
parents: 119
diff changeset
  1263
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1264
	entry isString ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1265
	    thisLength := (font widthOf:entry).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1266
	] ifFalse:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1267
	    thisLength := entry width
131
claus
parents: 130
diff changeset
  1268
	].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1269
	len := len + thisLength + wSpace + wSep + wSpace.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1270
    ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1271
    ^ len
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1272
! !
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1273
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1274
!PullDownMenu methodsFor:'queries'!
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1275
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1276
preferredExtent
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1277
    |w|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1278
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1279
    w := self titleLenUpTo:(titles size + 1).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1280
    ^ w @ (font height + (font descent * 2) "+ topMargin" + (margin*2)).
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1281
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1282
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1283
!PullDownMenu methodsFor:'submenu notifications'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1284
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1285
showActive
128
claus
parents: 119
diff changeset
  1286
    "sent by a menu to tell me that it starts to perform
claus
parents: 119
diff changeset
  1287
     its menu action."
131
claus
parents: 130
diff changeset
  1288
claus
parents: 130
diff changeset
  1289
    windowGroup notNil ifTrue:[windowGroup showCursor:Cursor wait]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
  1290
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
  1291
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1292
showPassive
128
claus
parents: 119
diff changeset
  1293
    "sent by a menu to tell me that it finished its menu-action.
claus
parents: 119
diff changeset
  1294
     Here, we hide the currently active menu."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1295
131
claus
parents: 130
diff changeset
  1296
    self hideActiveMenu.
claus
parents: 130
diff changeset
  1297
    windowGroup notNil ifTrue:[windowGroup restoreCursors]
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1298
!
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1299
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1300
submenuTriggered 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1301
    "sent by a sub-submenu to tell me that it finished its menu-action."
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1302
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1303
    self showPassive
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1304
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1305
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1306
!PullDownMenu class methodsFor:'documentation'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1307
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1308
version
291
71f4a66b3281 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 289
diff changeset
  1309
    ^ '$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.32 1996-01-17 11:18:40 cg Exp $'
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1310
! !