PullDownMenu.st
author Claus Gittinger <cg@exept.de>
Sun, 11 Dec 2016 22:13:54 +0100
changeset 6006 92827801f6ed
parent 5873 1aafcdef424c
child 6057 e3929e2b5edf
permissions -rw-r--r--
#UI_ENHANCEMENT by cg class: GenericToolbarIconLibrary changed: #deleteClassFromStart24x24Icon #deleteClassToEnd24x24Icon these icons did ot work on a dark grey background
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5873
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
     1
"{ Encoding: utf8 }"
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
     2
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     3
"
5
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     5
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    13
"
2254
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
    14
"{ Package: 'stx:libwidg' }"
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
    15
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
    16
"{ NameSpace: Smalltalk }"
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
    17
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
    18
View subclass:#PullDownMenu
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    19
	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
    20
		showSeparatingLines topMargin fgColor bgColor activeFgColor
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
    21
		activeBgColor onLevel offLevel edgeStyle toggleMode toggleKeep
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
    22
		raiseTopWhenActivated actions'
392
81343306d796 eliminated all DefaultFont classVars (are now classINSTvars)
Claus Gittinger <cg@exept.de>
parents: 317
diff changeset
    23
	classVariableNames:'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
    24
		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
    25
		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
    26
		DefaultShadowColor DefaultLightColor DefaultEdgeStyle
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
    27
		DefaultToggleMode DefaultKeepMenu DefaultToggleKeep
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
    28
		DefaultSeparatingLines'
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    29
	poolDictionaries:''
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
    30
	category:'Views-Menus'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    31
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    32
922
e6a5e1cf9565 resource spec updated
Claus Gittinger <cg@exept.de>
parents: 799
diff changeset
    33
!PullDownMenu class methodsFor:'documentation'!
3
claus
parents: 0
diff changeset
    34
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    35
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    36
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    37
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    38
	      All Rights Reserved
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    39
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    40
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    41
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    42
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    43
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    44
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    45
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    46
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    47
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    48
3
claus
parents: 0
diff changeset
    49
documentation
claus
parents: 0
diff changeset
    50
"
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
    51
    Notice: this class is obsolete now 
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
    52
    - please use a MenuPanel in new applications, 
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
    53
    which provides all of this functionality, plus more and a nicer look.
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    54
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    55
    PullDown menu provides the top (always visible) part of these menus. 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    56
    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
    57
    PullDownMenus entries is pressed.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    58
128
claus
parents: 119
diff changeset
    59
    A PullDownMenu itself consists of a single row of labels, which activate
claus
parents: 119
diff changeset
    60
    a pulled menu when clicked. Entries may be empty (i.e. have no menu)
claus
parents: 119
diff changeset
    61
    and empty entries may (optionally) also perform some action when clicked.
claus
parents: 119
diff changeset
    62
    An entries selector is used as the key to define and access submenus
claus
parents: 119
diff changeset
    63
    and (for empty entries:) the selector sent to the receiver of the menu.
claus
parents: 119
diff changeset
    64
586
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
    65
    [Instance variables:]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    66
128
claus
parents: 119
diff changeset
    67
      menus                   <Collection>    the sub menus
claus
parents: 119
diff changeset
    68
claus
parents: 119
diff changeset
    69
      titles                  <Collection>    the strings in the menu
claus
parents: 119
diff changeset
    70
claus
parents: 119
diff changeset
    71
      selectors               <Collection>    the selectors to send to the menu-
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    72
                                              receiver (for empty pull-menus)
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    73
                                              if nil (the default), title entries
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    74
                                              do not send anything.
128
claus
parents: 119
diff changeset
    75
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    76
      activeMenuNumber        <Number>        the index of the currently active menu
128
claus
parents: 119
diff changeset
    77
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    78
      showSeparatingLines     <Boolean>       show separating lines between my menu-strings
128
claus
parents: 119
diff changeset
    79
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
    80
      topMargin               <Number>        number of pixels at top
128
claus
parents: 119
diff changeset
    81
claus
parents: 119
diff changeset
    82
      fgColor                 <Color>         fg color to draw passive menu-titles
claus
parents: 119
diff changeset
    83
      bgColor                 <Color>         bg color to draw passive menu-titles
claus
parents: 119
diff changeset
    84
claus
parents: 119
diff changeset
    85
      activeFgColor           <Color>         fg color to draw activated menu-titles
claus
parents: 119
diff changeset
    86
      activeBgColor           <Color>         bg color to draw activated menu-titles
claus
parents: 119
diff changeset
    87
claus
parents: 119
diff changeset
    88
      onLevel                 <Integer>       3D level of entry-buttons when pressed
claus
parents: 119
diff changeset
    89
      offLevel                <Integer>       3D level of entry-buttons when released
claus
parents: 119
diff changeset
    90
claus
parents: 119
diff changeset
    91
      edgeStyle               <Symbol>        how to draw edges
claus
parents: 119
diff changeset
    92
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
    93
      toggleMode              <Symbol>        if #toggle, press pulls menu,
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    94
                                              another press hides it.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
    95
                                              if other, its hidden on release.
128
claus
parents: 119
diff changeset
    96
claus
parents: 119
diff changeset
    97
     except menus, titles and selectors, instvars are usually defined from
claus
parents: 119
diff changeset
    98
     defaults in the styleSheet; you should not care for them.
claus
parents: 119
diff changeset
    99
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   100
586
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
   101
    [StyleSheet values:]
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   102
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   103
      pullDownMenuViewBackground              view background Color for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   104
                                              default: menuViewBackground
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   105
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   106
      pullDownMenuForegroundColor             foreground drawing color for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   107
                                              default: menuForegroundColor
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   108
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   109
      pullDownMenuBackgroundColor             background drawing color for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   110
                                              default: menuBackgroundColor
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   111
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   112
      pullDownMenuHilightForegroundColor      active foreground drawing color for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   113
                                              default: menuHilightForegroundColor
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   114
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   115
      pullDownMenuHilightBackgroundColor      active background drawing color for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   116
                                              default: menuHilightBackgroundColor
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   117
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   118
      pullDownMenuHilightLevel                level (3D only) when active
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   119
                                              default: menuHilightLevel
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   120
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   121
      pullDownMenuEdgeStyle                   edge style (nil or #soft)
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   122
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   123
      pullDownMenuKeepMenu                    if true, pulled menu stays open until button
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   124
                                              is pressed again outside of the item-area (motif behavior)
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   125
                                              if false, menu closes on release (default)
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   126
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   127
      pullDownMenuToggleKeep                  if true, pulled menu closes when an entry is pressed
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   128
                                              again. Otherwise, only press outside of the items area
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   129
                                              hides it. default is false
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   130
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   131
      pullDownMenuLevel                       level (3D only)
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   132
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   133
      pullDownMenuFont                        font to use for the menu bar
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   134
                                              default: menuFont
128
claus
parents: 119
diff changeset
   135
claus
parents: 119
diff changeset
   136
      pullDownMenuShowSeparatingLines         if true, lines are drawn between items.
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   137
                                              default: false
133
claus
parents: 131
diff changeset
   138
claus
parents: 131
diff changeset
   139
      pullDownMenuRaiseTop                    if true, topview is raised whenever an entry
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   140
                                              is activated.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   141
                                              default: true
586
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
   142
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 572
diff changeset
   143
    [author:]
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   144
        Claus Gittinger
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   145
"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   146
!
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   147
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   148
examples 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   149
"
1149
583befe33648 comment
Claus Gittinger <cg@exept.de>
parents: 1148
diff changeset
   150
  with default level (from styleSheets 'pullDownMenuLevel' setting):
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   151
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   152
	|top menu|
128
claus
parents: 119
diff changeset
   153
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   154
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   155
	top extent:300@300.
128
claus
parents: 119
diff changeset
   156
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   157
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   158
	menu labels:#('foo' 'bar').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   159
	menu selectors:#(foo bar).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   160
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   161
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   162
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   163
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   164
	menu at:#bar 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   165
	     putLabels:#('bar1' 'bar2' 'bar3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   166
	     selectors:#(bar1 bar2 bar3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   167
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   168
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   169
									[exEnd]
128
claus
parents: 119
diff changeset
   170
1148
c7125994edea examples fixed (exBegin-exEnd)
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   171
  with a defined level:
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   172
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   173
	|top menu|
1148
c7125994edea examples fixed (exBegin-exEnd)
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   174
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   175
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   176
	top extent:300@300.
1148
c7125994edea examples fixed (exBegin-exEnd)
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   177
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   178
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   179
	menu level:1.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   180
	menu labels:#('foo' 'bar').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   181
	menu selectors:#(foo bar).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   182
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   183
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   184
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   185
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   186
	menu at:#bar 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   187
	     putLabels:#('bar1' 'bar2' 'bar3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   188
	     selectors:#(bar1 bar2 bar3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   189
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   190
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   191
									[exEnd]
128
claus
parents: 119
diff changeset
   192
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   193
128
claus
parents: 119
diff changeset
   194
    empty entries are possible as selectable items (with non-nil seletor) ...
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   195
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   196
	|top menu|
128
claus
parents: 119
diff changeset
   197
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   198
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   199
	top extent:300@300.
128
claus
parents: 119
diff changeset
   200
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   201
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   202
	menu labels:#('foo' 'bar' 'baz').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   203
	menu selectors:#(foo bar baz).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   204
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   205
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   206
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   207
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   208
	menu at:#baz 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   209
	     putLabels:#('baz1' 'baz2' 'baz3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   210
	     selectors:#(baz1 baz2 baz3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   211
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   212
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   213
									[exEnd]
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   214
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   215
128
claus
parents: 119
diff changeset
   216
    ... or as separators (with nil selector)
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   217
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   218
	|top menu|
128
claus
parents: 119
diff changeset
   219
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   220
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   221
	top extent:500@200.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   222
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   223
	menu := PullDownMenu origin:0.0@0.0 corner:1.0@30 in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   224
	menu labels:#('foo' '    ' 'bar' ' baz' '    ' 'moreFoo' 'moreBar' 'moreBaz').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   225
	menu selectors:#(foo nil bar baz nil moreFoo moreBar moreBaz).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   226
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   227
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   228
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   229
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   230
	menu at:#bar 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   231
	     putLabels:#('bar1' 'bar2' 'bar3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   232
	     selectors:#(bar1 bar2 bar3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   233
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   234
	menu at:#baz 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   235
	     putLabels:#('baz1' 'baz2' 'baz3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   236
	     selectors:#(baz1 baz2 baz3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   237
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   238
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   239
									[exEnd]
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   240
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   241
128
claus
parents: 119
diff changeset
   242
claus
parents: 119
diff changeset
   243
    use the menus default height
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   244
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   245
	|top menu|
128
claus
parents: 119
diff changeset
   246
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   247
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   248
	top extent:300@300.
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   249
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   250
	menu := PullDownMenu in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   251
	menu origin:0.0@0.0 corner:1.0@(menu height).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   252
	menu labels:#('foo' 'bar').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   253
	menu selectors:#(foo bar).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   254
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   255
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   256
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   257
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   258
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   259
									[exEnd]
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   260
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   261
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   262
605
11b03282d684 copy selectors, args & shortKeys
Claus Gittinger <cg@exept.de>
parents: 593
diff changeset
   263
    although you can change the font, colors etc. (as shown below)
128
claus
parents: 119
diff changeset
   264
    you should NOT do it - since if you do so, the styleSheet settings
605
11b03282d684 copy selectors, args & shortKeys
Claus Gittinger <cg@exept.de>
parents: 593
diff changeset
   265
    are ineffective (which users probably won't like)
128
claus
parents: 119
diff changeset
   266
    BTW: The styleSheet entries for below are pullDownMenuForegroundColor,
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   267
	 pullDownMenuBackgroundColor and pullDownMenuFont
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   268
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   269
	|top menu|
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   270
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   271
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   272
	menu := PullDownMenu in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   273
	menu font:(Font family:'courier' size:20).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   274
	menu foregroundColor:Color red.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   275
	menu backgroundColor:Color yellow.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   276
	menu viewBackground:Color green.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   277
	menu showSeparatingLines:true.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   278
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   279
	menu origin:0.0@0.0 corner:1.0@(menu height).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   280
	menu labels:#('foo' 'bar').
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   281
	menu selectors:#(foo bar).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   282
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   283
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   284
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   285
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   286
	(menu menuAt:#foo) font:(Font family:'courier' size:36).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   287
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   288
									[exEnd]
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   289
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   290
128
claus
parents: 119
diff changeset
   291
    you can use icons, too ...
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   292
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   293
	|labels top menu|
128
claus
parents: 119
diff changeset
   294
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   295
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   296
	top extent:300@300.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   297
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   298
	menu := PullDownMenu in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   299
	menu origin:0.0@0.0 corner:1.0@(menu height).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   300
	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   301
			with:'foo'
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   302
			with:'bar'.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   303
	menu labels:labels.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   304
	menu selectors:#(about foo bar).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   305
	menu at:#about 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   306
	     putLabels:#('about PullDownMenus')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   307
	     selectors:#(aboutMenus)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   308
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   309
	menu at:#foo
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   310
	     putLabels:#('foo1' 'foo2' 'foo3')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   311
	     selectors:#(foo1 foo2 foo3)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   312
	     receiver:nil.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   313
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   314
									[exEnd]
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   315
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   316
128
claus
parents: 119
diff changeset
   317
    a concrete example (combining things described above)
claus
parents: 119
diff changeset
   318
    (using a Plug, since we have no application class here):
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   319
									[exBegin]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   320
	|labels top menu textView appModel|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   321
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   322
	appModel := Plug new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   323
	appModel respondTo:#quit with:[top destroy].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   324
	appModel respondTo:#showAbout with:[self information:'some info here ...'].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   325
	appModel respondTo:#help with:[self information:'some help here ...'].
128
claus
parents: 119
diff changeset
   326
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   327
	top := StandardSystemView new.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   328
	top extent:300@300.
128
claus
parents: 119
diff changeset
   329
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   330
	menu := PullDownMenu in:top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   331
	menu receiver:appModel.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   332
	menu origin:0.0@0.0 corner:1.0@(menu height).
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   333
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   334
	textView := ScrollableView forView:(EditTextView new).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   335
	textView origin:0.0@menu height corner:1.0@1.0.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   336
	top addSubView:textView.
128
claus
parents: 119
diff changeset
   337
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   338
	labels := Array with:((Image fromFile:'SmalltalkX.xbm') magnifiedTo:16@16)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   339
			with:'file'
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   340
			with:'edit'
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   341
			with:'help'.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   342
	menu labels:labels.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   343
	menu selectors:#(about file edit help).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   344
	menu at:#about 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   345
	     putLabels:#('about PullDownMenus')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   346
	     selectors:#(showAbout)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   347
	     receiver:appModel.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   348
	menu at:#file 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   349
	     putLabels:#('quit')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   350
	     selectors:#(quit)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   351
	     receiver:appModel.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   352
	menu at:#edit 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   353
	     putLabels:#('copy' 'cut' 'paste')
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   354
	     selectors:#(copySelection cut paste)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   355
	     receiver:textView.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   356
	top open
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   357
									[exEnd]
3
claus
parents: 0
diff changeset
   358
"
1148
c7125994edea examples fixed (exBegin-exEnd)
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   359
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   360
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   361
922
e6a5e1cf9565 resource spec updated
Claus Gittinger <cg@exept.de>
parents: 799
diff changeset
   362
!PullDownMenu class methodsFor:'instance creation'!
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   363
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   364
labels:titleArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   365
    "create and return a new PullDownMenu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   366
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   367
    ^ self new labels:titleArray
3
claus
parents: 0
diff changeset
   368
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   369
922
e6a5e1cf9565 resource spec updated
Claus Gittinger <cg@exept.de>
parents: 799
diff changeset
   370
!PullDownMenu class methodsFor:'defaults'!
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   371
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   372
updateStyleCache
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   373
    "extract values from the styleSheet and cache them in class variables"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   374
1354
c260c896ea66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1280
diff changeset
   375
    <resource: #style (#'pullDownMenu.viewBackground' #'menuView.background'
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   376
                       #'pullDownMenu.foregroundColor' #'menu.foregroundColor'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   377
                       #'pullDownMenu.backgroundColor' #'menu.backgroundColor'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   378
                       #'pullDownMenu.hilightForegroundColor' #'menu.hilightForegroundColor'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   379
                       #'pullDownMenu.hilightBackgroundColor' #'menu.hilightBackgroundColor'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   380
                       #'pullDownMenu.hilightLevel' #'menu.hilightLevel'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   381
                       #'pullDownMenu.edgeStyle' 
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   382
                       #'pullDownMenu.toggleMode'
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   383
                       #'pullDownMenu.level'
2837
03d929f64d30 *** empty log message ***
ca
parents: 2749
diff changeset
   384
                       #'pullDownMenu.font' 
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   385
                       #'pullDownMenu.separatingLines')>
456
83c37597d5fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 392
diff changeset
   386
133
claus
parents: 131
diff changeset
   387
    |styleSheet|
claus
parents: 131
diff changeset
   388
claus
parents: 131
diff changeset
   389
    styleSheet := StyleSheet.
claus
parents: 131
diff changeset
   390
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   391
    DefaultViewBackground := styleSheet colorAt:#'pullDownMenu.viewBackground'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   392
    DefaultViewBackground isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   393
        DefaultViewBackground := styleSheet colorAt:#'menuView.background'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   394
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   395
    DefaultForegroundColor := styleSheet colorAt:#'pullDownMenu.foregroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   396
    DefaultForegroundColor isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   397
        DefaultForegroundColor := styleSheet colorAt:#'menu.foregroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   398
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   399
    DefaultBackgroundColor := styleSheet colorAt:#'pullDownMenu.backgroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   400
    DefaultBackgroundColor isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   401
        DefaultViewBackground notNil ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   402
            DefaultBackgroundColor := DefaultViewBackground
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   403
        ] ifFalse:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   404
            DefaultBackgroundColor := styleSheet colorAt:#'menu.backgroundColor'.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   405
        ]
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   406
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   407
    DefaultHilightForegroundColor := styleSheet colorAt:#'pullDownMenu.hilightForegroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   408
    DefaultHilightForegroundColor isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   409
        DefaultHilightForegroundColor := styleSheet colorAt:#'menu.hilightForegroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   410
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   411
    DefaultHilightBackgroundColor := styleSheet colorAt:#'pullDownMenu.hilightBackgroundColor'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   412
    DefaultHilightBackgroundColor isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   413
        DefaultHilightBackgroundColor := styleSheet colorAt:#'menu.hilightBackgroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   414
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   415
    DefaultHilightLevel := styleSheet at:#'pullDownMenu.hilightLevel'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   416
    DefaultHilightLevel isNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   417
        DefaultHilightLevel := styleSheet at:#'menu.hilightLevel' default:0.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   418
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   419
    DefaultEdgeStyle := styleSheet at:#'pullDownMenu.edgeStyle'.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   420
    DefaultToggleMode := styleSheet at:#'pullDownMenu.toggleMode' default:#toggle.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   421
    DefaultLevel := styleSheet at:#'pullDownMenu.level' default:1.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   422
    DefaultFont := styleSheet fontAt:#'pullDownMenu.font'.
2837
03d929f64d30 *** empty log message ***
ca
parents: 2749
diff changeset
   423
    DefaultFont isNil ifTrue:[
03d929f64d30 *** empty log message ***
ca
parents: 2749
diff changeset
   424
        DefaultFont := MenuView defaultFont
03d929f64d30 *** empty log message ***
ca
parents: 2749
diff changeset
   425
    ].
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
   426
    DefaultSeparatingLines := styleSheet at:#'pullDownMenu.separatingLines' default:false.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   427
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   428
    "
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   429
     PullDownMenu updateStyleCache
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
   430
    "
456
83c37597d5fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 392
diff changeset
   431
1354
c260c896ea66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1280
diff changeset
   432
    "Modified: 20.10.1997 / 14:02:28 / cg"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   433
! !
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   434
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   435
!PullDownMenu methodsFor:'accessing'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   436
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   437
add:label selector:selector
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   438
    "add a new title-item at the end.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   439
     The corresponding label can later be set with #at:putMenu:
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   440
     or #at:putLabels:selectors:..."
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   441
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   442
    self add:label selector:selector after:nil
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
   443
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   444
    "Modified: 5.6.1996 / 16:45:46 / cg"
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   445
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   446
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   447
add:label selector:selector after:indexOrString
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   448
    "add a new title-item after an existing item, indexOrString,
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   449
     or at the end if the after-arg is nil.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   450
     The corresponding label can later be set with #at:putMenu:
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   451
     or #at:putLabels:selectors:..."
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   452
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   453
    |idx|
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   454
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   455
    indexOrString isNil ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   456
        idx := titles size
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   457
    ] ifFalse:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   458
        idx := self indexOf:indexOrString.
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   459
    ].
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   460
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   461
    titles isNil ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   462
        menus := Array with:nil.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   463
        titles := Array with:label.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   464
        selectors := Array with:selector.
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   465
    ] ifFalse:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   466
        menus := menus copyWith:nil insertedAfterIndex:idx.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   467
        titles := titles copyWith:label insertedAfterIndex:idx.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   468
        selectors := selectors copyWith:selector insertedAfterIndex:idx.
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   469
    ].
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   470
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   471
    shown ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   472
        self redraw
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   473
    ]
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   474
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   475
    "
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   476
     |top m|
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   477
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   478
     top := StandardSystemView new.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   479
     m := PullDownMenu in:top.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   480
     m labels:#('file' 'edit').
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   481
     m selectors:#(file #edit).
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   482
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   483
     m add:'help' selector:#help after:#file.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   484
     m at:#help putMenu:(MenuView labels:#('foo' 'bar')
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   485
                               selectors:#(foo bar)
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   486
                                receiver:nil).
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   487
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   488
     top open
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   489
    "
532
689d1c622a14 oops - adding to an empty menu forgor selector
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   490
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   491
    "Modified: 5.7.1996 / 11:40:47 / cg"
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   492
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   493
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   494
add:label selector:selector before:indexOrString
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   495
    "add a new title-item before an existing item, indexOrString,
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   496
     or at the beginning if the before-arg is nil.
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   497
     The corresponding label can later be set with #at:putMenu:
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   498
     or #at:putLabels:selectors:..."
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   499
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   500
    |idx|
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   501
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   502
    indexOrString isNil ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   503
        idx := 1
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   504
    ] ifFalse:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   505
        idx := self indexOf:indexOrString.
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   506
    ].
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   507
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   508
    titles isNil ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   509
        menus := Array with:nil.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   510
        titles := Array with:label.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   511
        selectors := Array with:selector.
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   512
    ] ifFalse:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   513
        menus := menus copyWith:nil insertedAfterIndex:idx-1.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   514
        titles := titles copyWith:label insertedAfterIndex:idx-1.
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   515
        selectors := selectors copyWith:selector insertedAfterIndex:idx-1.
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   516
    ].
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   517
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   518
    shown ifTrue:[
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   519
        self redraw
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   520
    ]
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   521
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   522
    "
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   523
     |top m|
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   524
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   525
     top := StandardSystemView new.
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   526
     m := PullDownMenu in:top.
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   527
     m labels:#('file' 'edit').
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   528
     m selectors:#(file #edit).
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   529
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   530
     m add:'help' selector:#help before:#edit.
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   531
     m at:#help putMenu:(MenuView labels:#('foo' 'bar')
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   532
                               selectors:#(foo bar)
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   533
                                receiver:nil).
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   534
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   535
     m add:'foo' selector:#foo before:nil.
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   536
     m at:#foo putMenu:(MenuView labels:#('foo1' 'foo2')
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   537
                               selectors:#(foo1 foo2)
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
   538
                                receiver:nil).
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   539
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   540
     top open
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   541
    "
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   542
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   543
    "Modified: 5.7.1996 / 11:40:55 / cg"
772
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   544
!
9994f479be43 added #add:selector:before:
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   545
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   546
at:aString putLabels:labels selector:selector args:args receiver:anObject
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   547
    "create and set the menu under the title, aString
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   548
     OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   549
     single symbol-arg for selectors ..."
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   550
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   551
    ^ self at:aString putLabels:labels selectors:selector args:args receiver:anObject
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   552
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   553
    "Modified: 5.6.1996 / 16:47:32 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   554
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   555
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   556
at:aString putLabels:labels selectors:selectors
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   557
    "create and set the menu under the title, aString"
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   558
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   559
    ^ self at:aString putLabels:labels selectors:selectors receiver:nil
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   560
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   561
    "Created: 24.3.1996 / 17:06:45 / cg"
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   562
!
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   563
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   564
at:aString putLabels:labels selectors:selectors accelerators:shorties args:args receiver:anObject
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   565
    "create and set the menu under the title, aString"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   566
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   567
    |menuView|
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   568
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   569
    menuView := MenuView labels:labels
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   570
                      selectors:selectors
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   571
                   accelerators:shorties
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   572
                           args:args
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   573
                       receiver:anObject
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   574
                            for:self.
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   575
    self at:aString putMenu:menuView.
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   576
    ^ menuView
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   577
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   578
    "Created: 5.6.1996 / 16:51:48 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   579
!
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   580
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   581
at:aString putLabels:labels selectors:selectors accelerators:shorties receiver:anObject
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   582
    "create and set the menu under the title, aString"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   583
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   584
    ^ self at:aString putLabels:labels selectors:selectors accelerators:shorties args:nil receiver:anObject
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   585
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   586
    "Modified: 5.6.1996 / 16:48:26 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   587
    "Created: 5.6.1996 / 16:53:39 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   588
!
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   589
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   590
at:aString putLabels:labels selectors:selectors args:args receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   591
    "create and set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   592
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   593
    |menuView|
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
    menuView := MenuView labels:labels
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   596
                      selectors:selectors
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   597
                           args:args
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   598
                       receiver:anObject
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   599
                            for:self.
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   600
    self at:aString putMenu:menuView.
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   601
    ^ menuView
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   602
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   603
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   604
at:aString putLabels:labels selectors:selectors receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   605
    "create and set the menu under the title, aString"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   606
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   607
    ^ self at:aString putLabels:labels selectors:selectors args:nil receiver:anObject
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   608
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   609
    "Modified: 5.6.1996 / 16:48:26 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   610
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   611
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   612
at:aString putMenu:aMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   613
    "set the menu under the title, aString"
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
    |index|
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
    index := self indexOf:aString.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   618
    (index == 0) ifTrue:[
1980
8c7a9ecadb5e error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   619
        self error:'no such menu entry' mayProceed:true.
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   620
        ^ nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   621
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   622
620
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
   623
    aMenu container:(self superView).
291
71f4a66b3281 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 289
diff changeset
   624
    aMenu beInvisible.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   625
    menus at:index put:aMenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   626
    aMenu masterView:self.
620
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
   627
1607
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   628
    ^ aMenu
2d277721aa34 submenu creation methods return the new menu.
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
   629
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   630
    "Modified: 5.6.1996 / 16:48:50 / cg"
202
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   633
labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   634
    "return the menu-titles (group-headers)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   635
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   636
    ^ titles
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   637
!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   638
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   639
labels:titleArray
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   640
    "define the menu-titles (group-headers)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   641
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   642
    |numberOfLabels|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   643
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   644
    numberOfLabels := titleArray size.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   645
    menus := Array new:numberOfLabels.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   646
    titles := Array new:numberOfLabels.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   647
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   648
    titleArray keysAndValuesDo:[:index :entry |
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   649
        |e|
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   650
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   651
        entry isImage ifTrue:[
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   652
            e := entry onDevice:device
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   653
        ] ifFalse:[
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   654
            e := entry printString
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   655
        ].
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   656
        titles at:index put:e
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   657
    ].
2913
bdf4fb09cfc0 invalidate checks itself for shown-flag
Claus Gittinger <cg@exept.de>
parents: 2837
diff changeset
   658
    self invalidate "/ clear; redraw
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 714
diff changeset
   659
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 714
diff changeset
   660
    "Modified: 29.5.1996 / 16:21:00 / cg"
202
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   663
labels:titleArray selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   664
    "define the menu-titles (group-headers) and selectors.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   665
     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
   666
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   667
    self labels:titleArray.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   668
    self selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   669
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   670
    "Created: 20.10.1995 / 20:15:54 / cg"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   671
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   672
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   673
menuAt:stringOrNumber
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   674
    "return the menu with the title; nil if not found"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   675
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   676
    ^ self subMenuAt:stringOrNumber
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   677
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   678
    "Modified: 24.3.1996 / 17:10:11 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   679
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   680
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   681
numberOfTitles:n
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   682
    "setup blank title-space to be filled in later"
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
    menus := Array new:n.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   685
    titles := Array new:n
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   686
!
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
receiver:anObject 
5873
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   689
    "set the menu-receiver. 
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   690
     That's the one who gets the messages (both from myself and from my submenus).
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   691
     This only sets the receiver for menus which are already
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   692
     created - menus added later should get their receiver in
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   693
     the creation send."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   694
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   695
    receiver := anObject.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   696
    menus notNil ifTrue:[
5873
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   697
        menus do:[:aMenu |
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   698
            aMenu notNil ifTrue:[
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   699
                aMenu receiver:anObject
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   700
            ]
1aafcdef424c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5637
diff changeset
   701
        ]
202
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
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   704
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   705
remove:indexOrString
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   706
    "remove the menu, indexOrString."
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   707
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   708
    |idx|
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   709
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   710
    idx := self indexOf:indexOrString.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   711
    idx == 0 ifTrue:[^ self].
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   712
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   713
    menus removeIndex:idx.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   714
    titles removeIndex:idx.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   715
    selectors removeIndex:idx.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   716
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   717
    shown ifTrue:[
2925
f92ddaadddd3 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
   718
        self clearView.
f92ddaadddd3 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
   719
        self redraw
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   720
    ]
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   721
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   722
    "
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   723
     |top m|
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   724
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   725
     top := StandardSystemView new extent:300@200.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   726
     m := PullDownMenu in:top.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   727
     m labels:#('file' 'edit').
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   728
     m selectors:#(file #edit).
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   729
     top open.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   730
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   731
     Delay waitForSeconds:3.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   732
     m add:'help' selector:#help after:#file.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   733
     m at:#help putMenu:(MenuView labels:#('foo' 'bar')
2925
f92ddaadddd3 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
   734
                               selectors:#(foo bar)
f92ddaadddd3 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
   735
                                receiver:nil).
773
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   736
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   737
     Delay waitForSeconds:3.
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   738
     m remove:'help'
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   739
    "
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   740
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   741
    "Modified: 5.7.1996 / 11:43:08 / cg"
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   742
!
de7268eb5575 added #remove; update when changed while visible.
Claus Gittinger <cg@exept.de>
parents: 772
diff changeset
   743
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   744
selectors
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   745
    "return the menu-selectors"
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   746
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   747
    ^ selectors
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   748
!
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   749
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   750
selectors:selectorArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   751
    "define the menu-selectors. These are used as accesskey only
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   752
     in menuAt: accesses. This makes PullDownMenu accesss
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   753
     somewhat more compatible to PopUpMenus."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   754
605
11b03282d684 copy selectors, args & shortKeys
Claus Gittinger <cg@exept.de>
parents: 593
diff changeset
   755
    selectors := selectorArray copy.
283
f65545e96d72 protocol to add more items
ca
parents: 250
diff changeset
   756
605
11b03282d684 copy selectors, args & shortKeys
Claus Gittinger <cg@exept.de>
parents: 593
diff changeset
   757
    "Modified: 30.4.1996 / 15:57:04 / cg"
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   758
!
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   759
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   760
subMenuAt:stringOrNumber
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   761
    "return the menu with the title; nil if not found."
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   762
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   763
    |index|
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   764
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   765
    index := self indexOf:stringOrNumber.
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   766
    (index == 0) ifTrue:[^ nil].
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   767
    ^ menus at:index
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   768
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 516
diff changeset
   769
    "Modified: 24.3.1996 / 17:09:56 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   770
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   771
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   772
!PullDownMenu methodsFor:'accessing-behavior'!
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   773
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   774
actionAt:stringOrNumber
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   775
    "return the actionBlock associated with stringOrNumber; 
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   776
     nil if there is none (but there may be still a selector there)."
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   777
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   778
    |index|
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   779
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   780
    actions isNil ifTrue:[^ nil].
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   781
    index := self indexOf:stringOrNumber.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   782
    (index == 0) ifTrue:[^ nil].
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   783
    ^ actions at:index ifAbsent:nil
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   784
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   785
    "Modified: 24.3.1996 / 17:09:56 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   786
    "Created: 17.4.1996 / 20:50:45 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   787
!
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   788
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   789
actionAt:stringOrNumber put:aBlock
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   790
    "return the actionBlock associated with stringOrNumber; 
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   791
     nil if there is none (but there may be still a selector there)."
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   792
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   793
    |index newActions|
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   794
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   795
    index := self indexOf:stringOrNumber.
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   796
    (index == 0) ifTrue:[^ nil].
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   797
    actions size < index ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   798
	newActions := Array new:index.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   799
	newActions replaceFrom:1 to:actions size with:actions.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   800
	actions := newActions
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   801
    ].
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   802
    actions at:index put:aBlock
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   803
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   804
    "Modified: 24.3.1996 / 17:09:56 / cg"
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   805
    "Created: 17.4.1996 / 20:52:13 / cg"
2048
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   806
!
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   807
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   808
disable:anItem
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   809
    menus do:[:aMenu |
2050
c5a14f600d4c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2048
diff changeset
   810
        aMenu notNil ifTrue:[aMenu disable:anItem]
2048
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   811
    ]
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   812
!
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   813
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   814
enable:anItem
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   815
    menus do:[:aMenu |
2050
c5a14f600d4c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2048
diff changeset
   816
        aMenu notNil ifTrue:[aMenu enable:anItem]
2048
aa46b832f842 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1988
diff changeset
   817
    ]
750
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   818
! !
94db70fea830 added accelerator stuff
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   819
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   820
!PullDownMenu methodsFor:'accessing-look'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   821
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   822
backgroundColor:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   823
    "set the background drawing color.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   824
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   825
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   826
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   827
    bgColor := aColor onDevice:device
202
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   830
font:aFont
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   831
    "set the menus font.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   832
     adjusts menu-origins when font changes.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   833
     You should not use this method; instead leave the value as
665
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 631
diff changeset
   834
     defined in the styleSheet.
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 631
diff changeset
   835
     CAVEAT: with the addition of Text objects,
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   836
             this method is going to be obsoleted by a textStyle
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   837
             method, which allows specific control over
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   838
             normalFont/boldFont/italicFont parameters."
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   839
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   840
    |font|
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   841
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   842
    font := self font.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   843
    aFont ~~ font ifTrue:[
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   844
        super font:aFont.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   845
        font := self font.
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   846
        self height:(font height + (font descent * 2)).
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   847
        shown ifTrue:[
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   848
            self setMenuOrigins
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   849
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   850
    ]
665
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 631
diff changeset
   851
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 631
diff changeset
   852
    "Modified: 22.5.1996 / 12:37:04 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   853
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   854
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   855
foregroundColor:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   856
    "set the foreground drawing color.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   857
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   858
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   859
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   860
    fgColor := aColor onDevice:device
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   861
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   862
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   863
showSeparatingLines:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   864
    "turn on/off drawing of separating lines.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   865
     You should not use this method; instead leave the value as
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   866
     defined in the styleSheet."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   867
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   868
    showSeparatingLines := aBoolean.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   869
    shown ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   870
	self setMenuOrigins.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   871
	self invalidate
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   872
    ]
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 714
diff changeset
   873
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 714
diff changeset
   874
    "Modified: 29.5.1996 / 16:21:06 / cg"
202
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
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   877
!PullDownMenu methodsFor:'converting'!
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   878
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   879
asMenu
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   880
    ^ self asMenu:self
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   881
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   882
!
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   883
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   884
asMenu:aView
1280
460131bb2a9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
   885
    |menu values item subM rcv|
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   886
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   887
    menu   := Menu new.
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   888
    values := aView selectors.
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   889
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   890
    aView labels keysAndValuesDo:[:anIndex :aLabel|
4710
8a081c228e90 class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4678
diff changeset
   891
        item := MenuItem label:(aLabel printString).
2642
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   892
        aLabel isImage ifTrue:[
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   893
            rcv := ResourceRetriever new.
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   894
            rcv className:#MenuEditor.
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   895
            rcv selector:#iconUnknown.
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   896
            item resourceRetriever:rcv.
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   897
        ] ifFalse:[
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   898
            aView ~~ self ifTrue:[
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   899
                rcv := aView checkToggleAt:anIndex.
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   900
                rcv notNil ifTrue:[
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   901
                    item indication:rcv
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   902
                ]
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   903
            ]
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   904
        ].
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   905
2642
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   906
        subM := aView subMenuAt:anIndex.
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   907
2642
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   908
        subM notNil ifTrue:[
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   909
            item submenu:(self asMenu:subM)
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   910
        ].
2efe4b4e0b2c resourceRetriever access
Claus Gittinger <cg@exept.de>
parents: 2259
diff changeset
   911
        menu addItem:item value:(values at:anIndex).
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   912
    ].
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   913
  ^ menu
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   914
! !
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
   915
2144
8cfc21c91319 category rename
Claus Gittinger <cg@exept.de>
parents: 2137
diff changeset
   916
!PullDownMenu methodsFor:'drawing'!
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   917
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   918
drawActiveTitleSelected:selected
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   919
    |x|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   920
    activeMenuNumber notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   921
	x := self titleLenUpTo:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   922
	self drawTitle:(titles at:activeMenuNumber) x:x selected:selected 
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
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   925
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   926
drawTitle:stringOrImage x:x0 selected:selected
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   927
    |y w x wSpace fg bg map font|
202
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
    selected ifTrue:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   930
        fg := activeFgColor.
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   931
        bg := activeBgColor
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   932
    ] ifFalse:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   933
        fg := fgColor.
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   934
        bg := bgColor
202
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
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   937
    font := gc font.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   938
    wSpace := font widthOf:' '.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   939
    x := x0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   940
    stringOrImage isString ifTrue:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   941
        y := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   942
        w := font widthOf:stringOrImage.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   943
    ] ifFalse:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   944
        y := ((height - stringOrImage height) // 2) max:0.
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   945
        w := stringOrImage width
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   946
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   947
    w := w + (wSpace * 2).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   948
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   949
    self paint:bg.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   950
    self fillRectangleX:x y:0 width:w height:height.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   951
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   952
    self is3D ifTrue:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   953
        self drawEdgesForX:x y:0
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   954
                     width:w
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   955
                    height:height
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   956
                     level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   957
    ].
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
   958
    self paint:fg on:bg.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   959
    x := x + wSpace.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   960
    stringOrImage isString ifTrue:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   961
        self displayOpaqueString:stringOrImage x:x y:y
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   962
    ] ifFalse:[
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   963
        stringOrImage isImageOrForm ifTrue:[
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   964
            stringOrImage depth == 1 ifTrue:[
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   965
                (map := stringOrImage colorMap) notNil ifTrue:[
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   966
                    map at:1 put:((map at:1) onDevice:device).
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
   967
                    map at:2 put:((map at:2) onDevice:device).
938
6fc0f088a9a6 fetch device colors of image-item
Claus Gittinger <cg@exept.de>
parents: 937
diff changeset
   968
1988
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   969
                    self paint:(map at:2) on:(map at:1).
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   970
                    self displayOpaqueForm:stringOrImage x:x y:y.
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   971
                    ^ self
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   972
                ]
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   973
            ].
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   974
            self displayForm:stringOrImage x:x y:y
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   975
        ] ifFalse:[
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   976
            stringOrImage displayOn:self x:x y:y
55184833642a #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
   977
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   978
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   979
938
6fc0f088a9a6 fetch device colors of image-item
Claus Gittinger <cg@exept.de>
parents: 937
diff changeset
   980
    "Modified: 14.1.1997 / 00:06:07 / cg"
202
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
highlightActiveTitle
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   984
    self drawActiveTitleSelected:true 
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   987
redraw
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   988
    |x     "{ Class: SmallInteger }"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   989
     y     "{ Class: SmallInteger }"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   990
     index "{ Class: SmallInteger }" 
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   991
     wSpace clr font|
202
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
    shown ifFalse: [ ^ self ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   994
    titles isNil ifTrue:[^ self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   995
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   996
    font := gc font.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   997
    wSpace := (font widthOf:' ').
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   998
    x := 0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   999
    y := height "- 1".
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1000
    index := 1.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1001
    titles do:[:title |
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1002
        self drawTitle:title x:x selected:(index == activeMenuNumber).
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1003
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1004
        title isString ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1005
            x := x + (font widthOf:title).
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1006
        ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1007
            x := x + title width
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1008
        ].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1009
        x := x + wSpace + wSpace.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1010
        showSeparatingLines ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1011
            self is3D ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1012
                self paint:shadowColor.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1013
                self displayLineFromX:x y:0 toX:x y:y.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1014
                x := x + 1.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1015
                clr := lightColor.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1016
            ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1017
                clr := fgColor.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1018
            ].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1019
            self paint:clr.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1020
            self displayLineFromX:x y:0 toX:x y:y.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1021
            x := x + 1
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1022
        ].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1023
        index := index + 1
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1024
    ]
938
6fc0f088a9a6 fetch device colors of image-item
Claus Gittinger <cg@exept.de>
parents: 937
diff changeset
  1025
6fc0f088a9a6 fetch device colors of image-item
Claus Gittinger <cg@exept.de>
parents: 937
diff changeset
  1026
    "Modified: 14.1.1997 / 00:06:22 / cg"
202
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
unHighlightActiveTitle
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1030
    self drawActiveTitleSelected:false 
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1033
!PullDownMenu methodsFor:'event handling'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1034
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1035
buttonMotion:state x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1036
    |titleIndex activeMenu activeLeft activeTop|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1037
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1038
    state == 0 ifTrue:[
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1039
        "/ self hideActiveMenu.
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1040
        ^ self
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1041
    ].
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1042
    "is it the select or 1-button ?"
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1043
    self sensor anyButtonPressed ifFalse:[^ self].
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1044
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1045
    activeMenuNumber isNil ifTrue:[^ self].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1046
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1047
    activeMenuNumber notNil ifTrue:[
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1048
        activeMenu := menus at:activeMenuNumber.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1049
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1050
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1051
    (y < height) ifTrue:[
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1052
        "moving around in title line"
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1053
        activeMenu notNil ifTrue:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1054
            activeMenu setSelection:nil
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1055
        ].
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1056
        titleIndex := self titleIndexForX:x.
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1057
        titleIndex notNil ifTrue:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1058
            (titleIndex ~~ activeMenuNumber) ifTrue:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1059
                self pullMenu:titleIndex
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1060
            ]
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1061
        ] ifFalse:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1062
            self hideActiveMenu
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1063
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1064
    ] ifFalse:[
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1065
        "moving around below"
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1066
        activeMenu isNil ifTrue:[^self].
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1067
        activeLeft := activeMenu left.
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1068
        (x between:activeLeft and:(activeMenu right)) ifTrue:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1069
            activeTop := activeMenu top.
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1070
            (y between:activeTop and:(activeMenu bottom)) ifTrue:[
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1071
                "moving around in menu"
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1072
                activeMenu buttonMotion:state
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1073
                                      x:(x - activeLeft)
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1074
                                      y:(y - activeTop).
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1075
                ^ self
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1076
            ]
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1077
        ].
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1078
        "moved outside menu"
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1079
        activeMenu setSelection:nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1080
    ]
684
015c23130d7b selection: / setSelection:
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1081
1621
fa41bbb0d4f2 ignore motion events ifno button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1607
diff changeset
  1082
    "Modified: / 28.7.1998 / 16:01:50 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1083
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1084
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1085
buttonPress:button x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1086
    |titleIndex activeMenu activeLeft activeTop m|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1087
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1088
    self forceUngrabPointer.
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1089
    self forceUngrabKeyboard.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1090
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1091
    (y between:0 and:height) ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1092
        titleIndex := self titleIndexForX:x.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1093
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1094
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1095
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1096
     now, titleIndex is non-nil if pressed within myself
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1097
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1098
    (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1099
        "/ pressed on another item
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1100
        m := self pullMenu:titleIndex.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1101
        (toggleMode == #toggle) ifTrue:[
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1102
            self grabPointer.
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1103
            self grabKeyboard.
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1104
"/            self cursor:Cursor upRightArrow
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1105
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1106
    ] ifFalse:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1107
        titleIndex == activeMenuNumber ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1108
            "/ pressed on same item
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1109
            (toggleMode ~~ #toggle) ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1110
                "same pressed again ... stay"
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1111
                titleIndex notNil ifTrue:[
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1112
                    self grabPointer.
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1113
                    self grabKeyboard.
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1114
                ].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1115
            ] ifFalse:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1116
                self hideActiveMenu.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1117
            ].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1118
            ^ self
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1119
        ].
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1120
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1121
        "/ pressed outside
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1122
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1123
        activeMenuNumber isNil ifTrue:[^self].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1124
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1125
        activeMenu := menus at:activeMenuNumber.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1126
        activeLeft := activeMenu left.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1127
        (x between:activeLeft and:(activeMenu right)) ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1128
            activeTop := activeMenu top.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1129
            (y between:activeTop and:(activeMenu bottom)) ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1130
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1131
                "/ pressed inside currently pulled menu
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1132
                activeMenu buttonPress:button x:(x - activeLeft) y:(y - activeTop).
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1133
                ^ self
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1134
            ].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1135
        ].
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1136
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1137
        "/ somewhere else
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1138
        self hideActiveMenu.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1139
    ]
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1140
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1141
    "Modified: 6.3.1996 / 17:14:16 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1142
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1143
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1144
buttonRelease:button x:x y:y
1280
460131bb2a9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
  1145
    |activeMenu activeLeft activeTop hideMenu|
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1146
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1147
    activeMenuNumber isNil ifTrue:[^self].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1148
    activeMenu := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1149
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1150
    hideMenu := false.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1151
    (y >= height) ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1152
	"release below title-line"
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1153
	activeLeft := activeMenu left.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1154
	"
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1155
	 released in a submenu ?
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1156
	"
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1157
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1158
	    activeTop := activeMenu top.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1159
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1160
		"release in menu"
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1161
		self hideActiveMenu.   
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1162
		activeMenu buttonRelease:button
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1163
				       x:(x - activeLeft)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1164
				       y:(y - activeTop).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1165
		^ self
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1166
	    ]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1167
	].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1168
	hideMenu := true.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1169
    ] ifFalse:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1170
	y < 0 ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1171
	    hideMenu := true
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1172
	] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1173
	    activeMenu isNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1174
		self performSelectedAction.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1175
		hideMenu := true.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1176
	    ] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1177
		(toggleMode == #toggle) ifFalse:[   
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1178
		    hideMenu := true
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1179
		]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1180
	    ]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1181
	]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1182
    ].                  
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1183
    hideMenu ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1184
       self hideActiveMenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1185
    ]
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1186
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1187
    "Modified: 17.4.1996 / 20:56:08 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1188
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1189
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1190
keyPress:key x:x y:y
491
7b376aaa06d5 resources
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
  1191
922
e6a5e1cf9565 resource spec updated
Claus Gittinger <cg@exept.de>
parents: 799
diff changeset
  1192
    <resource: #keyboard (#CursorLeft #CursorRight #MenuSelect #Return)>
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1193
1280
460131bb2a9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
  1194
    |index startIndex m|
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1195
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1196
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1197
     handle CursorLeft/Right for non-mouse operation
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1198
     (for example, if it has the explicit focus)
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1199
     These will pull the previous/next menu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1200
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1201
    ((key == #CursorRight) or:[key == #CursorLeft]) ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1202
	activeMenuNumber isNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1203
	    index := (key == #CursorRight) ifTrue:[1] ifFalse:[menus size].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1204
	] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1205
	    (key == #CursorRight) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1206
		"/ if its a cursor-right, and the current item
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1207
		"/ has a submenu, then pop up the submenu
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1208
		m := menus at:activeMenuNumber.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1209
		m notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1210
		    m selectedItemHasSubmenu ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1211
			m showSubmenu:(m selection).
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1212
			^ self.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1213
		    ].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1214
		].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1215
	    ].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1216
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1217
	    (key == #CursorRight) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1218
		index := activeMenuNumber+1
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1219
	    ] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1220
		index := activeMenuNumber-1
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1221
	    ].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1222
	    index == 0 ifTrue:[index := menus size]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1223
	    ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1224
		index > menus size ifTrue:[index := 1]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1225
	    ]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1226
	].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1227
	self pullMenu:index.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1228
	^ self
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1229
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1230
513
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1231
"/    activeMenuNumber isNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1232
	"/
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1233
	"/ find an item starting with that alpha-key
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1234
	"/
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1235
	key isCharacter ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1236
	    (key isLetter) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1237
		activeMenuNumber isNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1238
		    startIndex := 1.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1239
		] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1240
		    startIndex := activeMenuNumber + 1
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1241
		].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1242
		index := titles 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1243
			    findFirst:[:item | 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1244
					    item isString
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1245
					    and:[(item startsWith:key asUppercase)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1246
						 or:[item startsWith:key asLowercase]]]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1247
			    startingAt:startIndex.
513
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1248
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1249
		(index == 0 and:[startIndex ~~ 1]) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1250
		    index := titles 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1251
				findFirst:[:item | 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1252
						item isString
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1253
						and:[(item startsWith:key asUppercase)
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1254
						     or:[item startsWith:key asLowercase]]]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1255
				startingAt:1.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1256
		].
513
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1257
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1258
		index ~~ 0 ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1259
		    self pullMenu:index.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1260
		].
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1261
		^ self
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1262
	    ]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1263
	].
513
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1264
"/    ].
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1265
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1266
    activeMenuNumber isNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1267
	^ super keyPress:key x:x y:y
513
97fe3c60042b quick item select (press alpha key for item)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1268
    ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1269
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1270
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1271
     Return, space or the (virtual) MenuSelect key trigger
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1272
     a menu entry (for non-submenu entries).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1273
     Otherwise, if we have a submenu open,
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1274
     pass the key on to it ...
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1275
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1276
    m := menus at:activeMenuNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1277
    m isNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1278
	(key == #Return 
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1279
	or:[key == #MenuSelect
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1280
	or:[key == Character space]]) ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1281
	    self performSelectedAction.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1282
	].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1283
    ] ifFalse:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1284
	m keyPress:key x:0 y:0.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1285
    ].
491
7b376aaa06d5 resources
Claus Gittinger <cg@exept.de>
parents: 487
diff changeset
  1286
1060
2ddc97677b4a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 958
diff changeset
  1287
    "Modified: 25.2.1997 / 23:38:15 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1288
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1289
309
b5c9d68e95e1 new tabbing scheme (asking via #canTab); new focus change (passing explicit to showFocus/noFocus);
Claus Gittinger <cg@exept.de>
parents: 291
diff changeset
  1290
showNoFocus:explicit
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1291
    "when stepping focus, hide any active menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1292
1060
2ddc97677b4a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 958
diff changeset
  1293
    explicit ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1294
	self hideActiveMenu.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1295
	super showNoFocus:explicit
1060
2ddc97677b4a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 958
diff changeset
  1296
    ]
2ddc97677b4a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 958
diff changeset
  1297
2ddc97677b4a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 958
diff changeset
  1298
    "Modified: 25.2.1997 / 23:31:38 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1299
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1300
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1301
!PullDownMenu methodsFor:'hiding/showing menus'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1302
4316
c3cf3ef81969 added: #cancelDelayedSubmenuHideOrShowAction
Claus Gittinger <cg@exept.de>
parents: 4196
diff changeset
  1303
cancelDelayedSubmenuHideOrShowAction
c3cf3ef81969 added: #cancelDelayedSubmenuHideOrShowAction
Claus Gittinger <cg@exept.de>
parents: 4196
diff changeset
  1304
c3cf3ef81969 added: #cancelDelayedSubmenuHideOrShowAction
Claus Gittinger <cg@exept.de>
parents: 4196
diff changeset
  1305
    "Created: / 30-09-2011 / 18:55:43 / cg"
c3cf3ef81969 added: #cancelDelayedSubmenuHideOrShowAction
Claus Gittinger <cg@exept.de>
parents: 4196
diff changeset
  1306
!
c3cf3ef81969 added: #cancelDelayedSubmenuHideOrShowAction
Claus Gittinger <cg@exept.de>
parents: 4196
diff changeset
  1307
317
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1308
hide 
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1309
    "sent by an aborted menu"
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1310
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1311
    self hideActiveMenu.
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1312
!
f23de8b78f5e Escape closes pullDownMenus & PopUpLists
Claus Gittinger <cg@exept.de>
parents: 309
diff changeset
  1313
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1314
hideActiveMenu
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1315
    "hide currently active menu - release grab if there is any grab"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1316
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1317
    ^ self hideActiveMenuRelease:true
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1318
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1319
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1320
hideActiveMenuRelease:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1321
    "hide currently active menu - release grab if aBoolean is true
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1322
     and a grab was set"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1323
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1324
    |m|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1325
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1326
    activeMenuNumber notNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1327
        (m := menus at:activeMenuNumber) notNil ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1328
            m beInvisible.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1329
        ].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1330
        self unHighlightActiveTitle.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1331
        activeMenuNumber := nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1332
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1333
    aBoolean ifTrue:[
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1334
        self forceUngrabKeyboard.
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1335
        self forceUngrabPointer. 
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1336
"/        self cursor:Cursor normal
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1337
    ].
476
c101043c91f7 oops - must release the keyboard as well
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1338
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1339
    "Modified: 6.3.1996 / 17:14:21 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1340
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1341
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1342
pullMenu:aNumber
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1343
    "activate a menu, return it or nil"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1344
1362
f2a9bc6ad68d new resource naming
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1345
    <resource: #style (#'pullDownMenu.autoselectFirst')>
760
62824e1f2607 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 750
diff changeset
  1346
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1347
    |subMenu r posY|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1348
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1349
    activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1350
    activeMenuNumber := aNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1351
    subMenu := menus at:aNumber.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1352
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1353
    raiseTopWhenActivated ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1354
        self topView raise.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1355
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1356
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1357
    (activeMenuNumber notNil 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1358
    and:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1359
         subMenu notNil
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1360
         or:[selectors notNil and:[(selectors at:activeMenuNumber) notNil]]]) ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1361
            self highlightActiveTitle.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1362
         ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1363
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1364
    subMenu notNil ifTrue:[
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1365
        subMenu origin:((left + (self titleLenUpTo:aNumber)) 
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1366
                       @
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1367
                       (posY := height + subMenu borderWidth)).
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1368
        subMenu hiddenOnRealize:false.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1369
        subMenu setSelection:nil.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1370
        subMenu create.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1371
        subMenu saveUnder:true.
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1372
        subMenu superMenu:self.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1373
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1374
        subMenu right > (r := self right) ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1375
            subMenu origin:((r - subMenu width) @ posY).
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1376
        ].
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1377
        subMenu raise show.
631
3b50fb0a505e support autoSelect of first item (motif style)
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  1378
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1379
        (styleSheet at:#'pullDownMenu.autoselectFirst') == true ifTrue:[
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1380
            subMenu setSelection:1
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1381
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1382
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1383
    ^ subMenu
631
3b50fb0a505e support autoSelect of first item (motif style)
Claus Gittinger <cg@exept.de>
parents: 620
diff changeset
  1384
1362
f2a9bc6ad68d new resource naming
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1385
    "Modified: / 26.10.1997 / 17:04:00 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1386
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1387
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1388
regainControl
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1389
    true ifTrue:[
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1390
        self grabPointer.
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1391
        self grabKeyboard.
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1392
"/        self cursor:Cursor upRightArrow
2071
90311d462be1 checkin from browser
ca
parents: 2050
diff changeset
  1393
        self sensor flushMotionEventsFor:nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1394
    ]
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1395
484
80c251cc9eff dont clobber hand-cursor
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
  1396
    "Modified: 6.3.1996 / 17:14:27 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1397
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1398
2749
8d2ce5027c36 method category rename
Claus Gittinger <cg@exept.de>
parents: 2642
diff changeset
  1399
!PullDownMenu methodsFor:'initialization & release'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1400
620
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1401
container:aView
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1402
    "when my container changes, all of my menus must change as well"
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1403
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1404
    super container:aView.
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1405
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1406
    menus notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1407
	menus do:[:aMenu |
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1408
	    aMenu notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1409
		aMenu container:aView
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1410
	    ]
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1411
	]
620
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1412
    ]
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1413
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1414
    "Modified: 9.5.1996 / 00:43:13 / cg"
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1415
    "Created: 9.5.1996 / 00:43:38 / cg"
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1416
!
f513bc136ab7 renamed #superView: to #container (migration towards ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 613
diff changeset
  1417
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1418
create
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1419
    super create.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1420
    self setMenuOrigins
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1421
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1422
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1423
destroy
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1424
    "have to destroy the menus manually here,
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1425
     since they are no real subviews of myself"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1426
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1427
    menus notNil ifTrue:[
3820
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1428
        menus do:[:m |
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1429
            m notNil ifTrue:[m destroy]
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1430
        ].
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1431
        "/ cg: no need to remove the submenus (they are already destroyed).
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1432
        "/ leaving the menus allows for reopening the receiver
fd8571890848 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3772
diff changeset
  1433
        "/ menus := nil
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1434
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1435
    activeMenuNumber := nil.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1436
    super destroy.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1437
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1438
933
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1439
fetchDeviceResources
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1440
    "fetch device colors, to avoid reallocation at redraw time"
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1441
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1442
    super fetchDeviceResources.
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1443
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1444
    bgColor notNil ifTrue:[bgColor := bgColor onDevice:device].
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1445
    fgColor notNil ifTrue:[fgColor := fgColor onDevice:device].
933
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1446
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1447
    activeBgColor notNil ifTrue:[activeBgColor := activeBgColor onDevice:device].
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1448
    activeFgColor notNil ifTrue:[activeFgColor := activeFgColor onDevice:device].
933
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1449
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1450
    "Created: 13.1.1997 / 23:25:14 / cg"
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1451
!
1916f11c9282 allocate device resources once
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
  1452
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1453
initCursor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1454
    "set up a hand cursor"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1455
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1456
    cursor := Cursor hand
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1457
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1458
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1459
initStyle
958
b75025112346 commentary
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1460
    "initialize style specifics"
b75025112346 commentary
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1461
3264
c650a6dc472f resource directive
Claus Gittinger <cg@exept.de>
parents: 2925
diff changeset
  1462
    <resource: #style (#name 
c650a6dc472f resource directive
Claus Gittinger <cg@exept.de>
parents: 2925
diff changeset
  1463
                       #'pullDownMenu.raiseTop' 
c650a6dc472f resource directive
Claus Gittinger <cg@exept.de>
parents: 2925
diff changeset
  1464
                       #'pullDownMenu.menuLevel')>
763
7af3f1baf479 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 760
diff changeset
  1465
2137
2642e627bb2a eliminated styleSheet name = win95 queries
Claus Gittinger <cg@exept.de>
parents: 2071
diff changeset
  1466
    |style l|
130
claus
parents: 128
diff changeset
  1467
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1468
    super initStyle.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1469
128
claus
parents: 119
diff changeset
  1470
    showSeparatingLines := DefaultSeparatingLines. "/ false.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1471
    DefaultViewBackground notNil ifTrue:[
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1472
        viewBackground := DefaultViewBackground onDevice:device
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1473
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1474
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1475
    DefaultForegroundColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1476
        fgColor := DefaultForegroundColor
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1477
    ] ifFalse:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1478
        fgColor := Black.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1479
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1480
    DefaultBackgroundColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1481
        bgColor := DefaultBackgroundColor
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1482
    ] ifFalse:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1483
        bgColor := viewBackground.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1484
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1485
    onLevel := DefaultHilightLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1486
    offLevel := DefaultLevel.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
  1487
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1488
    self is3D ifTrue:[
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1489
        device hasColors ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1490
            activeFgColor := Color name:'yellow'
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1491
        ] ifFalse:[
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1492
            activeFgColor := White
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1493
        ].
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1494
        device hasGrayscales ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1495
            activeBgColor := bgColor.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1496
        ] ifFalse:[
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1497
            activeBgColor := fgColor.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1498
        ].
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1499
        topMargin := 2.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
  1500
2137
2642e627bb2a eliminated styleSheet name = win95 queries
Claus Gittinger <cg@exept.de>
parents: 2071
diff changeset
  1501
        (l := styleSheet at:#'pullDownMenu.menuLevel') notNil ifTrue:[
2642e627bb2a eliminated styleSheet name = win95 queries
Claus Gittinger <cg@exept.de>
parents: 2071
diff changeset
  1502
            self level:l
2642e627bb2a eliminated styleSheet name = win95 queries
Claus Gittinger <cg@exept.de>
parents: 2071
diff changeset
  1503
        ].
2642e627bb2a eliminated styleSheet name = win95 queries
Claus Gittinger <cg@exept.de>
parents: 2071
diff changeset
  1504
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1505
        style := styleSheet name.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1506
        ((style == #iris) or:[style == #motif]) ifTrue:[
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1507
            onLevel := 2.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1508
            offLevel := 0.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1509
            activeFgColor := fgColor
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1510
        ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1511
    ] ifFalse:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1512
        activeFgColor := bgColor.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1513
        activeBgColor := fgColor.
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1514
        topMargin := 0
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1515
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1516
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1517
    edgeStyle := DefaultEdgeStyle.
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1518
    toggleMode := DefaultToggleMode.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1519
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1520
    DefaultHilightForegroundColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1521
        activeFgColor := DefaultHilightForegroundColor
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1522
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1523
    DefaultHilightBackgroundColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1524
        activeBgColor := DefaultHilightBackgroundColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1525
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1526
    DefaultShadowColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1527
        shadowColor := DefaultShadowColor
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1528
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1529
    DefaultLightColor notNil ifTrue:[
1678
2c63b6f17997 defaultLevel is 1 in win95 style.
Claus Gittinger <cg@exept.de>
parents: 1621
diff changeset
  1530
        lightColor := DefaultLightColor
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1531
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1532
1865
f2f2d6c93324 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1678
diff changeset
  1533
    raiseTopWhenActivated := styleSheet at:#'pullDownMenu.raiseTop' default:true.
709
a738bd76ace4 grey vs. gray
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
  1534
4325
d1db60deb969 comment/format in: #initStyle
az
parents: 4316
diff changeset
  1535
    "Modified: / 15-09-1998 / 22:58:42 / cg"
d1db60deb969 comment/format in: #initStyle
az
parents: 4316
diff changeset
  1536
    "Modified (comment): / 05-10-2011 / 15:50:54 / az"
133
claus
parents: 131
diff changeset
  1537
!
claus
parents: 131
diff changeset
  1538
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1539
initialize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1540
    super initialize.
133
claus
parents: 131
diff changeset
  1541
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1542
    self origin:(0.0 @ 0.0)
3610
e6de239e3bed added preferredWidth & preferredHeight
Claus Gittinger <cg@exept.de>
parents: 3264
diff changeset
  1543
         extent:(1.0 @ self preferredHeight)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1544
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1545
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1546
recreate
2259
9fddc0e95293 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  1547
    "sent after a snapin or a migration;
2254
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1548
     if the image was saved with an active menu, hide it"
128
claus
parents: 119
diff changeset
  1549
claus
parents: 119
diff changeset
  1550
    |m|
115
claus
parents: 112
diff changeset
  1551
claus
parents: 112
diff changeset
  1552
    activeMenuNumber notNil ifTrue:[
2254
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1553
        (m := menus at:activeMenuNumber) notNil ifTrue:[
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1554
            m unmap.
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1555
        ].
a3498d055bc1 comment
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
  1556
        activeMenuNumber := nil.
115
claus
parents: 112
diff changeset
  1557
    ].
claus
parents: 112
diff changeset
  1558
    super recreate.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1559
    self setMenuOrigins
613
7afeb510ce56 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 605
diff changeset
  1560
7afeb510ce56 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 605
diff changeset
  1561
    "Modified: 3.5.1996 / 23:48:55 / stefan"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1562
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1563
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1564
!PullDownMenu methodsFor:'private'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1565
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1566
indexOf:stringOrNumber
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1567
    "return the index of the menu with title; return 0 if not found.
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1568
     stringOrNumber may be a number, a selector from the selectorArray
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1569
     or a string from the title array.
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1570
     If stringOrNumber is not a valid item, return 0."
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1571
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1572
    |idx|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1573
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1574
    stringOrNumber isNumber ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1575
	^ stringOrNumber
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1576
    ].
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1577
    selectors notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1578
	idx := selectors indexOf:stringOrNumber.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1579
	idx ~~ 0 ifTrue:[^ idx].
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1580
    ].
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1581
    stringOrNumber isString ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1582
	^ titles indexOf:stringOrNumber
91
e8db16616e97 *** empty log message ***
claus
parents: 77
diff changeset
  1583
    ].
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1584
    (stringOrNumber respondsTo:#string) ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1585
	^ titles indexOf:stringOrNumber asString
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1586
    ].
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1587
    ^ 0
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1588
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
  1589
    "Modified: 27.4.1996 / 15:25:28 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1590
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1591
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1592
performEntry:itemIndex
769
e3fce8321d1f oops - did not work with a model
Claus Gittinger <cg@exept.de>
parents: 763
diff changeset
  1593
    |block sel|
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1594
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1595
    actions notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1596
	block := actions at:itemIndex.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1597
	block notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1598
	    block value.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1599
	    ^ self
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1600
	].
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1601
    ].
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1602
    selectors notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1603
	sel := selectors at:itemIndex.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1604
	sel notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1605
	    model notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1606
		model perform:sel
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1607
	    ] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1608
		receiver perform:sel
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1609
	    ]    
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1610
	].
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1611
    ].
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1612
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1613
    "Modified: 17.4.1996 / 20:55:11 / cg"
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1614
!
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1615
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1616
performSelectedAction
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1617
    |block sel|
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1618
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1619
    actions notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1620
	block := actions at:activeMenuNumber.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1621
	block notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1622
	    block value.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1623
	    ^ self
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1624
	].
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1625
    ].
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1626
    selectors notNil ifTrue:[
1403
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1627
	sel := selectors at:activeMenuNumber.
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1628
	sel notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1629
	    model notNil ifTrue:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1630
		model perform:sel
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1631
	    ] ifFalse:[
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1632
		receiver perform:sel
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1633
	    ]    
ddc59498d1c3 toggle & cursor behavior as in mswindows
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
  1634
	].
542
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1635
    ].
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1636
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1637
    "Modified: 17.4.1996 / 20:55:11 / cg"
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1638
    "Created: 17.4.1996 / 20:55:53 / cg"
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1639
!
25e48c7527f8 allow actionBlock-items
Claus Gittinger <cg@exept.de>
parents: 532
diff changeset
  1640
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1641
setMenuOrigins
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1642
    "adjust origins of menus when font changes"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1643
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1644
    (gc font graphicsDevice == device) ifTrue:[
4955
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1645
        menus notNil ifTrue:[
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1646
            menus keysAndValuesDo:[:index :aMenu |
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1647
                aMenu notNil ifTrue:[
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1648
                    aMenu origin:((left + (self titleLenUpTo:index)) 
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1649
                                  @
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1650
                                  (height + aMenu borderWidth))
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1651
                ].
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1652
            ]
d5ac89b4093d Access graphicsDevice via method send instead of instVar access
Stefan Vogel <sv@exept.de>
parents: 4710
diff changeset
  1653
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1654
    ]
516
656a8f993435 dont crash without items
Claus Gittinger <cg@exept.de>
parents: 513
diff changeset
  1655
779
2a63af1579fa use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 773
diff changeset
  1656
    "Modified: 5.7.1996 / 17:55:08 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1657
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1658
133
claus
parents: 131
diff changeset
  1659
someMenuItemLabeled:aLabel
claus
parents: 131
diff changeset
  1660
    "find a menu item.
claus
parents: 131
diff changeset
  1661
     Currently, in ST/X, instances of MenuItem are only created as dummy"
claus
parents: 131
diff changeset
  1662
claus
parents: 131
diff changeset
  1663
    |idx|
claus
parents: 131
diff changeset
  1664
claus
parents: 131
diff changeset
  1665
    idx := self indexOf:aLabel.
claus
parents: 131
diff changeset
  1666
    idx ~~ 0 ifTrue:[
claus
parents: 131
diff changeset
  1667
	^ MenuItem new menu:self index:idx
claus
parents: 131
diff changeset
  1668
    ].
claus
parents: 131
diff changeset
  1669
    menus notNil ifTrue:[
claus
parents: 131
diff changeset
  1670
	menus do:[:aMenu |
claus
parents: 131
diff changeset
  1671
	    |item|
claus
parents: 131
diff changeset
  1672
claus
parents: 131
diff changeset
  1673
	    aMenu notNil ifTrue:[
claus
parents: 131
diff changeset
  1674
		(item := aMenu someMenuItemLabeled:aLabel) notNil ifTrue:[
claus
parents: 131
diff changeset
  1675
		    ^ item
claus
parents: 131
diff changeset
  1676
		]
claus
parents: 131
diff changeset
  1677
	    ]
claus
parents: 131
diff changeset
  1678
	]
claus
parents: 131
diff changeset
  1679
    ].
claus
parents: 131
diff changeset
  1680
    ^ nil
claus
parents: 131
diff changeset
  1681
!
claus
parents: 131
diff changeset
  1682
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1683
titleIndexForX:x
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1684
    "given a click x-position, return index in title or nil"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1685
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1686
    |xstart "{ Class: SmallInteger }"
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1687
     xend   "{ Class: SmallInteger }" 
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1688
     wSpace wSep font|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1689
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1690
    font := gc font.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1691
    wSpace := (font widthOf:' ') * 2. 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1692
    showSeparatingLines ifTrue:[
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1693
        self is3D ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1694
            wSep := 2
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1695
        ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1696
            wSep := 1
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1697
        ]
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1698
    ] ifFalse:[
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1699
        wSep := 0
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1700
    ].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1701
    xstart := 0.
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1702
    1 to:(titles size) do:[:index |
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1703
        |entry thisLength|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1704
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1705
        entry := titles at:index.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1706
        entry isString ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1707
            thisLength := font widthOf:entry.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1708
        ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1709
            thisLength := entry width
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1710
        ].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1711
        xend := xstart + thisLength + wSpace + wSep.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1712
        (x between:xstart and:xend) ifTrue:[^ index].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1713
        xstart := xend
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1714
    ].
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1715
    ^ nil
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1716
!
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1717
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1718
titleLenUpTo:index
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1719
    "answer len (in pixels) of all title-strings up-to 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1720
     (but excluding) title-index. Used to compute x-position when drawing
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1721
     individual entries."
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1722
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1723
    |len "{ Class: SmallInteger }" 
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1724
     wSpace wSep font|
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1725
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1726
    (index <= 1) ifTrue:[^ 0].
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1727
    font := gc font.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1728
    wSpace := (font widthOf:' ').
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1729
    showSeparatingLines ifTrue:[
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1730
        self is3D ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1731
            wSep := 2
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1732
        ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1733
            wSep := 1
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1734
        ]
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1735
    ] ifFalse:[
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1736
        wSep := 0
133
claus
parents: 131
diff changeset
  1737
    ].
claus
parents: 131
diff changeset
  1738
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1739
    len := 0.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1740
    titles from:1 to:(index - 1) do:[:entry |
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1741
        |thisLength|
128
claus
parents: 119
diff changeset
  1742
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1743
        entry isString ifTrue:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1744
            thisLength := (font widthOf:entry).
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1745
        ] ifFalse:[
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1746
            thisLength := entry width
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1747
        ].
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1748
        len := len + thisLength + wSpace + wSep + wSpace.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1749
    ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1750
    ^ len
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1751
! !
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1752
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1753
!PullDownMenu methodsFor:'queries'!
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1754
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1755
preferredExtent
572
121735c2aff6 commentary
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
  1756
    "return my preferredExtent from the title-item widths & font height"
121735c2aff6 commentary
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
  1757
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1758
    |w hMax font|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1759
3772
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1760
    "/ If I have an explicit preferredExtent..
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1761
    explicitExtent notNil ifTrue:[
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1762
        ^ explicitExtent
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1763
    ].
799
64f8700489a4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 779
diff changeset
  1764
3772
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1765
    "/ If I have a cached preferredExtent value..
714
5ff02d2d9fa7 care for preSet preferredExtent
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
  1766
    preferredExtent notNil ifTrue:[
3772
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1767
        ^ preferredExtent
714
5ff02d2d9fa7 care for preSet preferredExtent
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
  1768
    ].
5ff02d2d9fa7 care for preSet preferredExtent
Claus Gittinger <cg@exept.de>
parents: 709
diff changeset
  1769
4959
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1770
    font := gc font.
76b3fff9c9bb Use message sends to access the font
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
  1771
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1772
    w := self titleLenUpTo:(titles size + 1).
1377
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1773
    hMax := font height + (font descent * 2).
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1774
    titles notNil ifTrue:[
3772
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1775
        titles do:[:aStringOrImage |
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1776
            aStringOrImage isString ifFalse:[
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1777
                hMax := hMax max:(aStringOrImage heightOn:self)
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1778
            ]
f0defaed2ddb changed #preferredExtent - use explicitExtent instvar
Stefan Vogel <sv@exept.de>
parents: 3610
diff changeset
  1779
        ]
1377
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1780
    ].
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1781
        
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1782
    ^ w @ (hMax + (margin*2) + ((onLevel abs max:offLevel abs)*2) "+ topMargin").
572
121735c2aff6 commentary
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
  1783
1377
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1784
    "Modified: / 31.10.1997 / 20:49:23 / cg"
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
  1785
!
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
  1786
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
  1787
specClass
1377
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1788
    "redefined, since the name of my specClass is nonStandard (i.e. not PullDownMenuSpec)"
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1789
1264
ce2db766b625 - set specClass to: MenuPanelSpec
ca
parents: 1224
diff changeset
  1790
    ^ MenuPanelSpec
1377
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1791
56fd9ea18a26 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1362
diff changeset
  1792
    "Modified: / 31.10.1997 / 19:48:23 / cg"
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1793
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1794
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1795
!PullDownMenu methodsFor:'submenu notifications'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1796
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1797
hideSubmenu
4196
c6f9c06c9b11 comment/format in: #hideSubmenu
Claus Gittinger <cg@exept.de>
parents: 3820
diff changeset
  1798
    "sent by an escaped menu - ignored here"
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1799
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1800
    ^ self
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1801
4196
c6f9c06c9b11 comment/format in: #hideSubmenu
Claus Gittinger <cg@exept.de>
parents: 3820
diff changeset
  1802
    "Modified: / 29-11-2010 / 19:51:17 / cg"
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1803
!
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1804
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1805
showActive
128
claus
parents: 119
diff changeset
  1806
    "sent by a menu to tell me that it starts to perform
claus
parents: 119
diff changeset
  1807
     its menu action."
131
claus
parents: 130
diff changeset
  1808
claus
parents: 130
diff changeset
  1809
    windowGroup notNil ifTrue:[windowGroup showCursor:Cursor wait]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
  1810
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
  1811
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1812
showPassive
128
claus
parents: 119
diff changeset
  1813
    "sent by a menu to tell me that it finished its menu-action.
claus
parents: 119
diff changeset
  1814
     Here, we hide the currently active menu."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1815
131
claus
parents: 130
diff changeset
  1816
    self hideActiveMenu.
claus
parents: 130
diff changeset
  1817
    windowGroup notNil ifTrue:[windowGroup restoreCursors]
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1818
!
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
  1819
110
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1820
submenuTriggered 
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1821
    "sent by a sub-submenu to tell me that it finished its menu-action."
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1822
eb59f6e31e84 *** empty log message ***
claus
parents: 95
diff changeset
  1823
    self showPassive
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1824
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1825
922
e6a5e1cf9565 resource spec updated
Claus Gittinger <cg@exept.de>
parents: 799
diff changeset
  1826
!PullDownMenu class methodsFor:'documentation'!
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1827
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1828
version
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1829
    ^ '$Header$'
4196
c6f9c06c9b11 comment/format in: #hideSubmenu
Claus Gittinger <cg@exept.de>
parents: 3820
diff changeset
  1830
!
c6f9c06c9b11 comment/format in: #hideSubmenu
Claus Gittinger <cg@exept.de>
parents: 3820
diff changeset
  1831
c6f9c06c9b11 comment/format in: #hideSubmenu
Claus Gittinger <cg@exept.de>
parents: 3820
diff changeset
  1832
version_CVS
5637
7d446673fa51 device access
Claus Gittinger <cg@exept.de>
parents: 4959
diff changeset
  1833
    ^ '$Header$'
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1834
! !
4678
7b9d701d947b class: PullDownMenu
Claus Gittinger <cg@exept.de>
parents: 4325
diff changeset
  1835