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