PopUpMenu.st
author Claus Gittinger <cg@exept.de>
Sat, 13 Jul 2019 14:10:43 +0200
changeset 6627 322e0fc5efc4
parent 6600 9a4a44808e01
child 6656 635b11260556
permissions -rw-r--r--
#BUGFIX by cg class: EditTextViewCompletionSupport changed: #startCompletionProcess
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6244
a24a9a3fbc7f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5636
diff changeset
     1
"{ Encoding: utf8 }"
a24a9a3fbc7f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5636
diff changeset
     2
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     3
"
5
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     5
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    13
"
2173
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
    14
"{ Package: 'stx:libwidg' }"
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
    15
5252
810023c78eb9 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 5049
diff changeset
    16
"{ NameSpace: Smalltalk }"
810023c78eb9 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 5049
diff changeset
    17
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    18
PopUpView subclass:#PopUpMenu
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
    19
	instanceVariableNames:'menuView lastSelection memorize hideOnLeave actionLabels
3365
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
    20
		actionLines actionValues hideOnRelease defaultHideOnRelease
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
    21
		hideOnAnyKey hideOnKeyFilter'
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
    22
	classVariableNames:''
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
    23
	poolDictionaries:''
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
    24
	category:'Views-Menus'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    25
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    26
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    27
!PopUpMenu class methodsFor:'documentation'!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    28
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
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    43
documentation
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    44
"
4685
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    45
    Warning: this is a very old class which was written well before many improved
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    46
    successors and tools were added. A lot of stuff you find here is kept for backward
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    47
    compatibility.
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    48
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    49
    This class provides PopUpMenu functionality;
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    50
    -> Actually, this class only provides the popup and shadow functionality 
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    51
       and wraps ANOTHER view, which shows the actual menu-list 
4685
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    52
       (usually an instance of MenuView, but in theory, other views could be wrapped as popup).
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    53
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    54
    PopUpMenus are usually created with a list of labels, selectors and a
4685
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    55
    receiver. 
717be378400e class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
    56
    Once activated, the specified receiver will be sent a 'selector'-message.
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    57
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    58
    PopupMenus may be either assigned statically to a view (via the #middleButtonMenu:
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    59
    message) or created dynamically as required.
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    60
    Static definition makes sense, if the menu stays constant and you want to
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    61
    assign it once for the lifetime of the view.
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    62
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    63
    Dynamic menus are easier to use, if the number of or look of the entries has to
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    64
    change according the internal state of some model. Also, this is the ST-80 way
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
    65
    of using popupMenus. For dynamic popups, the view's model is asked for a menu
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    66
    via the #menuSelector each time a button press occurs.
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    67
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
    68
    See examples section for more.
586
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 575
diff changeset
    69
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 575
diff changeset
    70
    [author:]
032b3245e53a documentation
Claus Gittinger <cg@exept.de>
parents: 575
diff changeset
    71
        Claus Gittinger
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    72
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    73
    [see also:]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    74
        PullDownMenu MenuView
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
    75
"
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
    76
!
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    77
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
    78
examples
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
    79
"
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    80
  The ST-80 way of opening menus is to startUp a menu,
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    81
  and use the returned value:
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    82
                                                                        [exBegin]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    83
    |p|
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
    84
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    85
    p := PopUpMenu
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    86
            labels:#('foo' 'bar' 'baz').
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    87
    Transcript showCR:p startUp
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    88
                                                                        [exEnd]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    89
  It returns the index of the selected item or 0 if nothing was selected.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    90
  This opening is done by either the controller or the view (if it has
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    91
  a middleButtonMenu and/or a menuHolder).
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    92
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    93
  If the numeric index is inconvenient, alternative values may be specified
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    94
  as in (here, nil is returned if nothing was selected):
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    95
                                                                        [exBegin]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    96
    |p|
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    97
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    98
    p := PopUpMenu
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
    99
            labels:#('foo' 'bar' 'baz')
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   100
            values:#('hello foo' 'hello bar' 'hello baz').
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   101
    Transcript showCR:p startUp
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   102
                                                                        [exEnd]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   103
  In ST/X, the above is actually done by a mimicri method (#startUp)
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   104
  and menus are typically created in one of the following ways:
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   105
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   106
  -> With a single actionBlock.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   107
     This is convenient, if all actions shall perform a similar task, 
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   108
     but require different arguments.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   109
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   110
  this is evaluated, passing the selections index or value as argument.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   111
  The action block is NOT evaluated, if nothing was selected.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   112
    With index:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   113
                                                                        [exBegin]
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   114
    |p|
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   115
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   116
    p := PopUpMenu
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   117
            labels:#('foo' 'bar' 'baz').
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   118
    p action:[:item | Transcript showCR:item].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   119
    p showAtPointer
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   120
                                                                        [exEnd]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   121
    With individual arguments:
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   122
                                                                        [exBegin]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   123
    |p|
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   124
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   125
    p := PopUpMenu
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   126
            labels:#('foo' 'bar' 'baz')
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   127
            args:#('hello foo' 'hello bar' 'hello baz').
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   128
    p action:[:item | Transcript showCR:item].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   129
    p showAtPointer
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   130
                                                                        [exEnd]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   131
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   132
  -> With an explicit receiver and different selectors.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   133
     This is convenient, if you have to send per-item messages
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   134
     to some object (typically, the receiver is the view or a model)
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   135
                                                                        [exBegin]
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   136
    |p m|
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   137
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   138
    m := Plug new.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   139
    m respondTo:#foo with:[Transcript showCR:'foo received'].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   140
    m respondTo:#bar with:[Transcript showCR:'bar received'].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   141
    m respondTo:#maz with:[Transcript showCR:'maz received'].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   142
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   143
    p := PopUpMenu
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   144
            labels:#('foo' 'bar' 'baz')
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   145
            selectors:#(#foo #bar #baz)
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   146
            receiver:m.
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   147
    p showAtPointer
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   148
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   149
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   150
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   151
  More examples:
459
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   152
    dynamic with action instead of selector being sent:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   153
                                                                        [exBegin]
459
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   154
        |p|
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   155
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   156
        p := PopUpMenu
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   157
                labels:(($a to: $d) collect:[:char | char asString])
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   158
                selectors:nil
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   159
                receiver:nil.
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   160
        p action:[:idx | Transcript showCR:'selected index is '; showCR:idx].
459
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   161
        p showAtPointer
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   162
                                                                        [exEnd]
459
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   163
5c35e2f02d27 another dynamic menu example
ca
parents: 426
diff changeset
   164
545
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   165
    individual actions:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   166
                                                                        [exBegin]
545
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   167
        |p|
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   168
        p := PopUpMenu
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   169
                labels:#('foo'
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   170
                         'bar'
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   171
                         'baz')
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   172
                selectors:#(
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   173
                            #foo
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   174
                            #bar
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   175
                            #baz).
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   176
        p actionAt:#foo put:[Transcript showCR:'foo'].
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   177
        p actionAt:#bar put:[Transcript showCR:'bar'].
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   178
        p actionAt:#baz put:[Transcript showCR:'baz'].
545
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   179
        p showAtPointer
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   180
                                                                        [exEnd]
545
18991fcbdb99 commentary
Claus Gittinger <cg@exept.de>
parents: 518
diff changeset
   181
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   182
    sometimes, you want to specify both selectors and some arguments
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   183
    to be sent; this is done by:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   184
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   185
        |p|
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   186
        p := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   187
                labels:#('foo' 'bar' 'baz')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   188
                selectors:#(#foo: #bar: #foo:)
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   189
                args:#(1 2 3)
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   190
                receiver:nil.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   191
        p showAtPointer
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   192
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   193
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   194
    or, the same selector but different arguments:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   195
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   196
        |p|
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   197
        p := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   198
                labels:#('foo' 'bar' 'baz')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   199
                selectors:#foo:
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   200
                args:#(1 2 3)
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   201
                receiver:nil.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   202
        p showAtPointer
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   203
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   204
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   205
    Normally, you do not show the menu explicitely, but install
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   206
    it as a either as middleButtonMenu of some view or return it from
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   207
    a model. 
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   208
    (Views/Controllers button-event handler will show it when the middle
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   209
    button is pressed ...)
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   210
    Static menu:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   211
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   212
        |v m|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   213
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   214
        v := View new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   215
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   216
                labels:#('lower'
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   217
                         'raise'
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   218
                         '-'
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   219
                         'destroy')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   220
                selectors:#(#lower #raise nil #destroy)
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   221
                receiver:v.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   222
        v middleButtonMenu:m.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   223
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   224
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   225
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   226
    Dynamic menu:
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   227
    (since we need some model which responds to a menu-message,
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   228
     we use a plug in the example below; normally, this would be your model)
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   229
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   230
        |v model|
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   231
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   232
        model := Plug new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   233
        model respondTo:#getMenu with:[PopUpMenu labels:#('foo' 'bar')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   234
                                                 selectors:#(foo bar)].
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   235
        model respondTo:#foo with:[Transcript showCR:'models foo called'].
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   236
        model respondTo:#bar with:[Transcript showCR:'models bar called'].
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   237
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   238
        v := View new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   239
        v model:model; menu:#getMenu.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   240
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   241
                                                                        [exEnd]
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   242
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   243
    Dynamic menus are the MVC-way (i.e. ST-80) way of doing things.
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   244
    They are usually easier to use, if the menu changes depending on the models
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   245
    state. (for example, see the systemBrowsers menus being different when
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   246
    things are selected ...)
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
   247
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   248
    It is also possible, to add check-mark entries, with an entry string
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   249
    starting with the special sequence '\c' (for check-mark). The value
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   250
    passed will be the truth-state of the check-mark.
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   251
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   252
        |m v|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   253
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   254
        v := View new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   255
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   256
                labels:#('\c foo'
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   257
                         '\c bar')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   258
                selectors:#(#value: #value:)
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   259
                receiver:[:v | Transcript show:'arg: '; showCR:v].
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   260
        v middleButtonMenu:m.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   261
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   262
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   263
404
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   264
    The style of the checkmark can be: check (\c), box (\b) or thumbs (\t):
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   265
                                                                        [exBegin]
404
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   266
        |m v|
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   267
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   268
        v := View new.
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   269
        m := PopUpMenu
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   270
                labels:#('\c foo'
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   271
                         '\b bar'
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   272
                         '\t baz')
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   273
                selectors:#(#value: #value: #value:)
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   274
                receiver:[:v | Transcript show:'arg: '; showCR:v].
404
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   275
        v middleButtonMenu:m.
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   276
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   277
                                                                        [exEnd]
404
6a32f6111fce example added
Claus Gittinger <cg@exept.de>
parents: 348
diff changeset
   278
406
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   279
    or at the end (looks better with variable fonts):
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   280
                                                                        [exBegin]
406
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   281
        |m v|
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   282
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   283
        v := View new.
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   284
        m := PopUpMenu
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   285
                labels:#('foo \c'
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   286
                         'bar \b'
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   287
                         'baz \t')
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   288
                selectors:#(#value: #value: #value:)
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   289
                receiver:[:v | Transcript show:'arg: '; showCR:v].
406
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   290
        v middleButtonMenu:m.
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   291
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   292
                                                                        [exEnd]
406
00b4fb72a566 examples
Claus Gittinger <cg@exept.de>
parents: 404
diff changeset
   293
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   294
    Finally, you can wrap other views into a popup menu (for example,
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   295
    to implement menus with icons or other components).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   296
    The view should respond to some messages sent from here (for
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   297
    example: #hideSubmenus, #deselectWithoutRedraw and others).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   298
    Currently there is only one class in the system, which can be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   299
    this way (PatternMenu in the DrawTool demo):
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   300
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   301
        |v p|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   302
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   303
        v := View new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   304
        p := PatternMenu new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   305
        p patterns:(Array with:Color red
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   306
                          with:Color green
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   307
                          with:Color blue).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   308
        v middleButtonMenu:(PopUpMenu forMenu:p).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   309
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   310
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   311
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   312
    or try:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   313
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   314
        |v p|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   315
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   316
        v := View new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   317
        p := PatternMenu new.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   318
        p patterns:(Array with:Color red
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   319
                          with:Color green
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   320
                          with:Color blue).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   321
        p selectors:#value:.
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   322
        p receiver:[:val | v viewBackground:val. v clear].
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   323
        p args:(Array with:Color red
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   324
                      with:Color green
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   325
                      with:Color blue).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   326
        v middleButtonMenu:(PopUpMenu forMenu:p).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   327
        v open
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   328
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   329
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   330
        
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   331
    ST-80 style:
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   332
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   333
    The above menus all did some message send on selection; it is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   334
    also possible, to use Smalltalk-80 style menus (which return some value
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   335
    from their startup method):
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   336
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   337
        |m selection|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   338
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   339
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   340
                labels:#('one' 'two' 'three').
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   341
        selection := m startUp.
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   342
        Transcript show:'the selection was: '; showCR:selection
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   343
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   344
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   345
    startUp will return the entries index, or 0 if there was no selection.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   346
    You can also specify an array of values to be returned instead of the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   347
    index:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   348
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   349
        |m selection|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   350
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   351
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   352
                labels:#('one' 'two' 'three')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   353
                values:#(10 20 30).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   354
        selection := m startUp.
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   355
        Transcript show:'the value was: '; showCR:selection
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   356
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   357
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   358
    In ST/X style menus, separating lines between entries are created
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   359
    by a '-'-string as its label text (and corresponding nil-entries in the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   360
    selectors- and args-arrays).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   361
    In ST-80, you have to pass the indices of the lines in an extra array:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   362
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   363
        |m selection|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   364
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   365
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   366
                labels:#('one' 'two' 'three' 'four' 'five')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   367
                lines:#(2 4).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   368
        selection := m startUp.
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   369
        Transcript show:'the value was: '; showCR:selection
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   370
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   371
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   372
    or:
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   373
                                                                        [exBegin]
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   374
        |m selection|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   375
284
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   376
        m := PopUpMenu
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   377
                labels:#('one' 'two' 'three')
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   378
                lines:#(2)
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   379
                values:#(10 20 30).
fb625951b7fc beispiel
Claus Gittinger <cg@exept.de>
parents: 281
diff changeset
   380
        selection := m startUp.
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   381
        Transcript show:'the value was: '; showCR:selection
593
86dd024ed773 examples
Claus Gittinger <cg@exept.de>
parents: 586
diff changeset
   382
                                                                        [exEnd]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   383
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   384
    Use whichever interface you prefer.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   385
"
119
claus
parents: 112
diff changeset
   386
! !
claus
parents: 112
diff changeset
   387
claus
parents: 112
diff changeset
   388
!PopUpMenu class methodsFor:'instance creation'!
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   389
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   390
forMenu:aMenuView
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   391
    "this wraps an already existing menu - allowing to put any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   392
     view (not just MenuViews) into popups (for example, menus
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   393
     with icons, or other components).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   394
     Currently, there is only one example of different menus in
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   395
     the system (PatternMenu in the DrawTool) which could be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   396
     this way.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   397
     The view should respond to some of the menuView messages
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   398
     (such as hideSubmenu, deselectWithoutRedraw etc.)"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   399
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   400
    |newMenu|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   401
2402
b64bf5ff83eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2399
diff changeset
   402
    aMenuView isView ifFalse:[
6600
9a4a44808e01 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
   403
        ArgumentError raise
2402
b64bf5ff83eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2399
diff changeset
   404
    ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   405
    newMenu := self onSameDeviceAs:aMenuView. 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   406
    newMenu addSubView:aMenuView.
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
   407
    newMenu menuView:aMenuView.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   408
    ^ newMenu
6600
9a4a44808e01 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
   409
9a4a44808e01 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
   410
    "Modified: / 06-06-2019 / 23:22:10 / Claus Gittinger"
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   411
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   412
1505
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   413
itemList:itemList resources:resources
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   414
    "like labels:selectors:... messages, but expects a single collection,
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   415
     containing items row-wise (i.e. elements are themself arrays, consisting of
1606
8ab3d7e85ea2 comment
Claus Gittinger <cg@exept.de>
parents: 1543
diff changeset
   416
        label [selector [accelerator [arg]]]
1505
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   417
     if resources are non-nil, labels are translated using the translations found there.
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   418
    "
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   419
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   420
    ^ self
1506
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   421
        itemList:itemList resources:resources receiver:nil for:nil
1505
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   422
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   423
    "the sometimes more convenient:
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   424
        |p|
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   425
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   426
        p := PopUpMenu
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   427
                itemList:#(('foo' doFoo CtrlF)
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   428
                           ('-')
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   429
                           ('bar' doBar CtrlB)
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   430
                           ('baz' doBaz CtrlZ))
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   431
                resources:nil.
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   432
        p showAtPointer
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   433
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   434
     does the same as:
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   435
        |p|
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   436
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   437
        p := PopUpMenu
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   438
                labels:#('foo' '-' 'bar' 'baz')
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   439
                selectors:#(doFoo nil doBar doBaz)
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   440
                accelerators:#(CtrlF nil CtrlB CtrlZ).
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   441
        p showAtPointer
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   442
    "
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   443
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   444
!
66e010d679a9 added #itemList: instance creation.
Claus Gittinger <cg@exept.de>
parents: 1442
diff changeset
   445
1543
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   446
itemList:itemList resources:resources performer:menuPerformer
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   447
    "like labels:selectors:... messages, but expects a single collection,
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   448
     containing items row-wise (i.e. elements are themself arrays, consisting of
1606
8ab3d7e85ea2 comment
Claus Gittinger <cg@exept.de>
parents: 1543
diff changeset
   449
        label [selector [accelerator [arg]]]
1543
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   450
     if resources are non-nil, labels are translated using the translations found there.
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   451
    "
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   452
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   453
    ^ self
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   454
        itemList:itemList resources:resources receiver:menuPerformer for:nil
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   455
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   456
    "Created: / 21.5.1998 / 15:31:42 / cg"
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   457
!
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   458
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   459
itemList:itemList resources:resources performer:menuPerformer for:aView
1506
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   460
    "like labels:selectors:... messages, but expects a single collection,
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   461
     containing items row-wise (i.e. elements are themself arrays, consisting of
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   462
        label [selector [accelerator [arg]]]
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   463
     if resources are non-nil, labels are translated using the translations found there.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   464
    "
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   465
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   466
    |n labels selectors accelerators args anyArg|
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   467
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   468
    n := itemList size.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   469
    labels := Array new:n.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   470
    selectors := Array new:n.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   471
    accelerators := Array new:n.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   472
    anyArg := false.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   473
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   474
    itemList keysAndValuesDo:[:idx :item |
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   475
        |label selector accelerator arg|
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   476
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   477
        label := item at:1.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   478
        labels at:idx put:label.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   479
        item size > 1 ifTrue:[
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   480
            selector := item at:2.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   481
            selectors at:idx put:selector.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   482
            item size > 2 ifTrue:[
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   483
                accelerator := item at:3.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   484
                accelerators at:idx put:accelerator.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   485
                item size > 3 ifTrue:[
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   486
                    arg := item at:4.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   487
                    anyArg ifFalse:[
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   488
                        anyArg := true.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   489
                        args := Array new:n.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   490
                    ].
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   491
                    args at:idx put:arg.    
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   492
                ]
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   493
            ]
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   494
        ].
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   495
    ].
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   496
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   497
    resources notNil ifTrue:[
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   498
        labels := resources array:labels
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   499
    ].
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   500
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   501
    ^ self
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   502
        labels:labels
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   503
        selectors:selectors
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   504
        accelerators:accelerators
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   505
        args:args 
1543
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   506
        receiver:menuPerformer 
1506
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   507
        for:aView
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   508
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   509
    "this is sometimes more convenient:
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   510
        |p|
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   511
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   512
        p := PopUpMenu
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   513
                itemList:#(('foo' doFoo CtrlF)
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   514
                           ('-')
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   515
                           ('bar' doBar CtrlB)
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   516
                           ('baz' doBaz CtrlZ))
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   517
                resources:nil.
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   518
        p showAtPointer
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   519
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   520
     and does the same as:
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   521
        |p|
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   522
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   523
        p := PopUpMenu
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   524
                labels:#('foo' '-' 'bar' 'baz')
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   525
                selectors:#(doFoo nil doBar doBaz)
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   526
                accelerators:#(CtrlF nil CtrlB CtrlZ).
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   527
        p showAtPointer
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   528
    "
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   529
1543
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   530
    "Created: / 21.5.1998 / 15:32:39 / cg"
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   531
!
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   532
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   533
itemList:itemList resources:resources receiver:menuPerformer for:aView
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   534
    "like labels:selectors:... messages, but expects a single collection,
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   535
     containing items row-wise (i.e. elements are themself arrays, consisting of
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   536
        label [selector [accelerator [arg]]]
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   537
     if resources are non-nil, labels are translated using the translations found there.
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   538
    "
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   539
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   540
    ^ self
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   541
        itemList:itemList resources:resources performer:menuPerformer for:aView
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   542
74f627922fea checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
   543
    "Modified: / 21.5.1998 / 15:33:04 / cg"
1506
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   544
!
63fb353fe997 better #itemList entry
Claus Gittinger <cg@exept.de>
parents: 1505
diff changeset
   545
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   546
labels:labels args:args 
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   547
    "create and return a menu with label-items and args. 
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   548
     The actionBlock has to be defined later"
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   549
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   550
    ^ self labels:labels selectors:nil accelerators:nil args:args receiver:nil for:nil
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   551
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   552
    "
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   553
     |m|
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   554
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   555
     m := PopUpMenu labels:#('foo' 'bar')
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   556
                      args:#('hello world' 'how about this').
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   557
     m action:[:arg |
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   558
        Transcript showCR:arg
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   559
     ].
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   560
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   561
     m showAtPointer
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   562
    "
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   563
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   564
    "Modified: 25.5.1996 / 17:01:43 / cg"
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   565
!
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   566
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   567
labels:labels selector:aSelector args:args receiver:anObject
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   568
    "create and return a popup menu with labels as entries.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   569
     Each item will send aSelector with a corresponding argument from the
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   570
     args array to anObject. The menu is created on the default DIsplay"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   571
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   572
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   573
     OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   574
    "
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   575
    ^ self labels:labels selectors:aSelector accelerators:nil args:args receiver:anObject
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   576
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   577
    "Modified: 28.2.1996 / 19:01:12 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   578
!
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
labels:labels selector:aSelector args:args receiver:anObject for:aView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   581
    "create and return a popup menu with labels as entries.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   582
     Each item will send aSelector with a corresponding argument from the
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   583
     args array to anObject. The menu is created on the same physical device
258
ae4b8f1a6738 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
   584
     as aView (which is only of interest in multi-Display applications; 
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   585
     typical applications can use the sibbling message without the for: argument)."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   586
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   587
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   588
     OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   589
    "
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   590
    ^ self labels:labels selectors:aSelector accelerators:nil args:args receiver:anObject for:aView
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   591
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   592
    "Modified: 28.2.1996 / 19:01:29 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   593
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   594
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   595
labels:labels selectors:selectors 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   596
    "create and return a menu with label-items and selectors. The receiver
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   597
     will either be defined later, or not used at all (if opened via startUp)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   598
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   599
    ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:nil for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   600
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   601
    "Modified: 28.2.1996 / 19:01:35 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   602
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   603
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   604
labels:labels selectors:selectors accelerators:shorties 
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   605
    "create and return a menu with label-items and selectors. The receiver
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   606
     will either be defined later, or not used at all (if opened via startUp)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   607
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   608
    ^ self labels:labels selectors:selectors accelerators:shorties args:nil receiver:nil for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   609
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   610
    "Created: 28.2.1996 / 18:58:52 / cg"
202
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
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   613
labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   614
    "create and return a popup menu with labels as entries.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   615
     Each item will send a corresponding selector:argument from the selectors-
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   616
     and args array to anObject. The menu is created on the default Display"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   617
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   618
    ^ self labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   619
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   620
    "Created: 28.2.1996 / 18:59:03 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   621
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   622
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   623
labels:labels selectors:selectors accelerators:shorties args:args receiver:anObject for:aView
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   624
    "create and return a popup menu with labels as entries.
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   625
     Each item will send a corresponding selector:argument from the selectors-
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   626
     and args array to anObject. The menu is created on the same physical device
258
ae4b8f1a6738 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
   627
     as aView (which is only of interest in multi-Display applications; 
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   628
     typical applications can use the sibbling message without the for: argument)."
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   629
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   630
    |newMenu m|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   631
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   632
    newMenu := self onSameDeviceAs:aView. 
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   633
    m := (MenuView
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   634
            labels:labels
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   635
            selectors:selectors
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   636
            accelerators:shorties 
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   637
            args:args
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   638
            receiver:anObject
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   639
            in:newMenu).
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   640
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   641
    m level:0; borderWidth:0.
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
   642
    newMenu menuView:m.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   643
    ^ newMenu
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   644
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   645
    "Created: 28.2.1996 / 18:59:25 / cg"
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
   646
    "Modified: 25.2.1997 / 20:52:47 / cg"
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   647
!
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   648
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   649
labels:labels selectors:selectors accelerators:shorties receiver:anObject
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   650
    "create and return a popup menu with labels as entries.
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   651
     Each item will send a message with a selector from the corresponding 
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   652
     selectors-array.
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   653
     The menu is created on the default Display."
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   654
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   655
    ^ self labels:labels selectors:selectors accelerators:shorties args:nil receiver:anObject for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   656
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   657
    "Created: 28.2.1996 / 19:00:49 / cg"
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   658
!
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   659
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   660
labels:labels selectors:selectors args:argArray 
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   661
    "create and return a menu with label-items and selectors. The receiver
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   662
     will either be defined later, or not used at all (if opened via startUp)"
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   663
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   664
    ^ self labels:labels selectors:selectors accelerators:nil args:argArray receiver:nil for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   665
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   666
    "Modified: 28.2.1996 / 19:01:45 / cg"
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   667
!
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   668
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   669
labels:labels selectors:selectors args:args receiver:anObject
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   670
    "create and return a popup menu with labels as entries.
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   671
     Each item will send a corresponding selector:argument from the selectors-
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   672
     and args array to anObject. The menu is created on the default Display"
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   673
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   674
    ^ self labels:labels selectors:selectors accelerators:nil args:args receiver:anObject for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   675
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   676
    "Modified: 28.2.1996 / 19:01:49 / cg"
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   677
!
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   678
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   679
labels:labels selectors:selectors args:args receiver:anObject for:aView
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   680
    "create and return a popup menu with labels as entries.
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   681
     Each item will send a corresponding selector:argument from the selectors-
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   682
     and args array to anObject. The menu is created on the same physical device
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   683
     as aView (which is only of interest in multi-Display applications; 
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   684
     typical applications can use the sibbling message without the for: argument)."
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   685
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   686
    ^ self labels:labels selectors:selectors accelerators:nil args:args receiver:anObject for:aView
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   687
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   688
    "Modified: 28.2.1996 / 19:03:58 / cg"
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   689
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   690
119
claus
parents: 112
diff changeset
   691
labels:labels selectors:selectors receiver:anObject
claus
parents: 112
diff changeset
   692
    "create and return a popup menu with labels as entries.
claus
parents: 112
diff changeset
   693
     Each item will send a message with a selector from the corresponding 
claus
parents: 112
diff changeset
   694
     selectors-array.
claus
parents: 112
diff changeset
   695
     The menu is created on the default Display."
claus
parents: 112
diff changeset
   696
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   697
    ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:anObject for:nil
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   698
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   699
    "Modified: 28.2.1996 / 19:02:07 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   700
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   701
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   702
labels:labels selectors:selectors receiver:anObject for:aView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   703
    "create and return a popup menu with labels as entries.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   704
     Each item will send a corresponding selector from the selectors-array
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   705
     to anObject. The menu is created on the same physical device
258
ae4b8f1a6738 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 205
diff changeset
   706
     as aView (which is only of interest in multi-Display applications; 
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   707
     typical applications can use the sibbling message without the for: argument)."
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   708
426
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   709
    ^ self labels:labels selectors:selectors accelerators:nil args:nil receiver:anObject for:aView
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   710
bf35bf40ab11 changes for accelerator-display
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
   711
    "Modified: 28.2.1996 / 19:02:10 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   712
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   713
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   714
!PopUpMenu class methodsFor:'ST-80 instance creation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   715
4544
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   716
labelArray:labels
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   717
    "ST80R4 compatibility"
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   718
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   719
    ^ self labels:labels lines:nil values:nil
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   720
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   721
    "
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   722
     (PopUpMenu labelArray:#('one' 'two' 'three')) startUp 
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   723
    "
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   724
!
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
   725
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   726
labelArray:labels lines:lines values:values 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   727
    "ST80R4 compatibility"
119
claus
parents: 112
diff changeset
   728
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   729
    ^ self labels:labels lines:lines values:values 
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   730
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   731
119
claus
parents: 112
diff changeset
   732
labelArray:labels values:values 
claus
parents: 112
diff changeset
   733
    "ST80R4 compatibility"
claus
parents: 112
diff changeset
   734
claus
parents: 112
diff changeset
   735
    ^ self labels:labels lines:nil values:values 
claus
parents: 112
diff changeset
   736
!
claus
parents: 112
diff changeset
   737
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   738
labelList:labels 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   739
    "ST80R4 compatibility:
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   740
	given a list consisting of group label entries (to be separated by
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   741
	lines), convert into standard form (using '-' for lines.
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   744
    ^ self labelList:labels values:nil
119
claus
parents: 112
diff changeset
   745
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   746
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   747
     (PopUpMenu labels:#('1' '2' '3')) showAtPointer
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   748
     (PopUpMenu labelList:#(('1') ('2' '3'))) showAtPointer    
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   749
     (PopUpMenu labelList:#(('1') ('2') ('3'))) showAtPointer    
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
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   752
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   753
labelList:labels lines:lines values:values 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   754
    "mhmh what is that ?"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   755
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   756
    ^ (self new) labels:labels lines:lines values:values 
119
claus
parents: 112
diff changeset
   757
!
claus
parents: 112
diff changeset
   758
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   759
labelList:labels values:values 
119
claus
parents: 112
diff changeset
   760
    "ST80R4 compatibility:
claus
parents: 112
diff changeset
   761
	given a list consisting of group label entries (to be separated by
claus
parents: 112
diff changeset
   762
	lines), convert into standard form (using '-' for lines.
claus
parents: 112
diff changeset
   763
    "
claus
parents: 112
diff changeset
   764
claus
parents: 112
diff changeset
   765
    |newLabels newValues lS vS first|
claus
parents: 112
diff changeset
   766
claus
parents: 112
diff changeset
   767
    newLabels := OrderedCollection new.
claus
parents: 112
diff changeset
   768
    newValues := OrderedCollection new.
claus
parents: 112
diff changeset
   769
    lS := ReadStream on:labels.
claus
parents: 112
diff changeset
   770
    values notNil ifTrue:[vS := ReadStream on:values].
claus
parents: 112
diff changeset
   771
    first := true.
claus
parents: 112
diff changeset
   772
    [lS atEnd] whileFalse:[
claus
parents: 112
diff changeset
   773
	|entry|
claus
parents: 112
diff changeset
   774
claus
parents: 112
diff changeset
   775
	entry := lS next.
claus
parents: 112
diff changeset
   776
	entry isCollection ifTrue:[
claus
parents: 112
diff changeset
   777
	    first ifFalse:[
claus
parents: 112
diff changeset
   778
		newLabels add:'-'.
claus
parents: 112
diff changeset
   779
		values notNil ifTrue:[newValues add:nil]
claus
parents: 112
diff changeset
   780
	    ].
claus
parents: 112
diff changeset
   781
	    newLabels addAll:entry.
claus
parents: 112
diff changeset
   782
	    values notNil ifTrue:[newValues addAll:(vS next:entry size)]
claus
parents: 112
diff changeset
   783
	] ifFalse:[
claus
parents: 112
diff changeset
   784
	    newLabels add:entry.
claus
parents: 112
diff changeset
   785
	    values notNil ifTrue:[newValues add:(vS next)]
claus
parents: 112
diff changeset
   786
	].
claus
parents: 112
diff changeset
   787
	first := false.
claus
parents: 112
diff changeset
   788
    ].
claus
parents: 112
diff changeset
   789
    values isNil ifTrue:[
claus
parents: 112
diff changeset
   790
	^ self labels:newLabels
claus
parents: 112
diff changeset
   791
    ].
claus
parents: 112
diff changeset
   792
    ^ self labels:newLabels values:newValues
claus
parents: 112
diff changeset
   793
claus
parents: 112
diff changeset
   794
    "
claus
parents: 112
diff changeset
   795
     (PopUpMenu labels:#('1' '2' '3') values:#(1 2 3)) showAtPointer
claus
parents: 112
diff changeset
   796
     (PopUpMenu labelList:#(('1') ('2' '3')) values:#(1 2 3)) showAtPointer    
claus
parents: 112
diff changeset
   797
     (PopUpMenu labelList:#(('1') ('2') ('3')) values:#(1 2 3)) showAtPointer    
claus
parents: 112
diff changeset
   798
    "
claus
parents: 112
diff changeset
   799
!
claus
parents: 112
diff changeset
   800
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   801
labels:labels 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   802
    "ST80R2 compatibility"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   803
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   804
    ^ self labels:labels lines:nil values:nil 
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   805
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   806
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   807
labels:labels lines:lines 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   808
    "ST80R2 compatibility"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   809
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   810
    ^ self labels:labels lines:lines values:nil
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   811
!
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   812
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   813
labels:labels lines:lines values:values 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   814
    "ST80R2 compatibility"
127
claus
parents: 126
diff changeset
   815
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   816
    ^ (self new) labels:labels lines:lines values:values 
77
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   817
!
565b052f5277 *** empty log message ***
claus
parents: 70
diff changeset
   818
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   819
labels:labels values:values 
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   820
    "ST80R2 compatibility"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   821
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   822
    ^ self labels:labels lines:nil values:values 
127
claus
parents: 126
diff changeset
   823
! !
claus
parents: 126
diff changeset
   824
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
   825
!PopUpMenu class methodsFor:'defaults'!
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
   826
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
   827
maxClickTimeToStayOpen
2946
19af20c4f04f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2742
diff changeset
   828
    ^ 200  "/ if button is pressed shorter, its a click and the menu stays open.
19af20c4f04f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2742
diff changeset
   829
           "/ otherwise, its a press and the menu hides itself with the release
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
   830
! !
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
   831
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   832
!PopUpMenu methodsFor:'ST-80 activation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   833
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   834
startUp
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   835
    "start the menu modal - return the selected value,
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   836
     or - if no values where specified - return the index.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   837
     If nothing was selected, return 0.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   838
     Modal - i.e. stay in the menu until finished.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   839
     This is the ST-80 way of launching a menu."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   840
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   841
    ^ self startUpAt:nil
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   842
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   843
    "
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   844
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp 
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   845
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   846
                                  values:#(foo bar baz)) startUp
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   847
    "
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   848
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   849
    "Modified: 10.1.1996 / 20:16:40 / cg"
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   850
!
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   851
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   852
startUpAt:aPoint
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   853
    "start the menu modal - return the selected value,
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   854
     or - if no values where specified - return the index.
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   855
     If nothing was selected, return 0.
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   856
     Modal - i.e. stay in the menu until finished.
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   857
     This is the ST-80 way of launching a menu."
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   858
2173
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   859
    ^ self startUpAt:aPoint ifNoneSelected:0
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   860
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   861
    "
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   862
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp 
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   863
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   864
                                  values:#(foo bar baz)) startUp
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   865
    "
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   866
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   867
!
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   868
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   869
startUpAt:aPoint ifNoneSelected:defaultReturnValue
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   870
    "start the menu modal - return the selected value,
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   871
     or - if no values where specified - return the index.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   872
     If nothing was selected, return defaultReturnValue.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   873
     Modal - i.e. stay in the menu until finished.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   874
     This is the ST-80 way of launching a menu."
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   875
1354
c260c896ea66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1285
diff changeset
   876
    |return rec sel0 sel1 arg myAction|
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   877
2173
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   878
    return := defaultReturnValue.
2041
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   879
    actionValues notNil ifTrue:[
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   880
        return := nil
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   881
    ].
1175
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
   882
"/    menuView args notNil ifTrue:[
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
   883
"/        return := nil
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
   884
"/    ].
119
claus
parents: 112
diff changeset
   885
495
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   886
    "/
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   887
    "/ arrange for the menu to evaluate this action,
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   888
    "/ instead of directly sending any messages to the menuReceiver.
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   889
    "/ (which used to be the ST/X way, menus worked).
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   890
    "/ This works better with menuPerformers - which were not
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   891
    "/ supported when ST/X menus were originally written.
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   892
    "/ The old ST/X mechanism may vanish.
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   893
    "/
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   894
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   895
    menuView action isNil ifTrue:[
1354
c260c896ea66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1285
diff changeset
   896
        myAction := true.
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   897
        menuView action:[:menuView :selected |
726
bef52bf8f6c3 oops - menuAction is now called with arg if there is one
Claus Gittinger <cg@exept.de>
parents: 692
diff changeset
   898
            |actionIndex value sel retVal selIdx
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   899
             args selectors checkFlags check|
119
claus
parents: 112
diff changeset
   900
2067
99763d5655ce must clear the actionBlock when invoked.
Claus Gittinger <cg@exept.de>
parents: 2041
diff changeset
   901
            menuView action:nil.  "/ must clear it ...  
2041
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   902
            retVal := 0.
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   903
            actionValues notNil ifTrue:[
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   904
                retVal := nil
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   905
            ].
8107fe7c8cff if item-values were defined,
Claus Gittinger <cg@exept.de>
parents: 2038
diff changeset
   906
878
b1b2839ff515 if the menu has an item-action, do not perform
ca
parents: 754
diff changeset
   907
            selected isNil ifTrue:[
b1b2839ff515 if the menu has an item-action, do not perform
ca
parents: 754
diff changeset
   908
                "/ the menu has already sent a message or performed an item-action; do nothing here
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   909
                retVal
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   910
            ] ifFalse:[
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   911
                selIdx := menuView selection.
568
ba7d2bc390ae oops - checkFlags passed wrong arg
Claus Gittinger <cg@exept.de>
parents: 545
diff changeset
   912
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   913
                args := menuView args.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   914
                selectors := menuView selectors.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   915
                checkFlags := menuView checkFlags.
568
ba7d2bc390ae oops - checkFlags passed wrong arg
Claus Gittinger <cg@exept.de>
parents: 545
diff changeset
   916
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   917
                args isNil ifTrue:[
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   918
                    selectors notNil ifTrue:[
726
bef52bf8f6c3 oops - menuAction is now called with arg if there is one
Claus Gittinger <cg@exept.de>
parents: 692
diff changeset
   919
                        sel0 := selectors at:selIdx.
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   920
                    ].
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   921
                ] ifFalse:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   922
                    actionIndex := selected.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   923
                    actionIndex notNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   924
                        actionValues isNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   925
                            selectors notNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   926
                                "/ mhmh an ST/X menu started the ST-80 way
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   927
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   928
                                sel1 := selectors at:selIdx.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   929
                                arg := actionIndex.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   930
                            ] ifFalse:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   931
                                retVal := actionIndex
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   932
                            ]
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   933
                        ] ifFalse:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   934
                            retVal := actionValues at:actionIndex.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   935
                            (retVal isKindOf:PopUpMenu) ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   936
                                retVal := retVal startUp
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   937
                            ]
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   938
                        ]
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   939
                    ] ifFalse:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   940
                        "/ mhmh an ST/X menu started the ST-80 way
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   941
3594
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   942
                        selectors notNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   943
                            sel0 := selectors at:selIdx.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   944
                        ].
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   945
                    ]
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   946
                ].
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   947
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   948
                checkFlags notNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   949
                    check := checkFlags at:selIdx.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   950
                    check notNil ifTrue:[
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   951
                        arg := check.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   952
                        sel1 := sel0.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   953
                        sel0 := nil.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   954
                    ]
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   955
                ].
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   956
                return := retVal.
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   957
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   958
                menuView action:nil
e298287e2968 do not return twice from a block
Claus Gittinger <cg@exept.de>
parents: 3493
diff changeset
   959
            ]
692
65c5499f4cea examples
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   960
        ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   961
    ].
495
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   962
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   963
    aPoint isNil ifTrue:[
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
   964
        self showAt:(device pointerPosition) resizing:true
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   965
    ] ifFalse:[
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   966
        self showAt:aPoint.
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   967
    ].
1354
c260c896ea66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1285
diff changeset
   968
    myAction == true ifTrue:[menuView action:nil].
96
5996b2afa4fb *** empty log message ***
claus
parents: 95
diff changeset
   969
5996b2afa4fb *** empty log message ***
claus
parents: 95
diff changeset
   970
    "/ 
5996b2afa4fb *** empty log message ***
claus
parents: 95
diff changeset
   971
    "/ mhmh an ST/X menu started the ST-80 way
5996b2afa4fb *** empty log message ***
claus
parents: 95
diff changeset
   972
    "/
5996b2afa4fb *** empty log message ***
claus
parents: 95
diff changeset
   973
    (sel0 notNil or:[sel1 notNil]) ifTrue:[
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   974
        rec := menuView receiver.
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   975
        sel0 notNil ifTrue:[
495
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   976
            ^ sel0
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   977
        ].
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
   978
        ^ Array with:sel1 with:arg.
95
7535cfca9509 *** empty log message ***
claus
parents: 81
diff changeset
   979
    ].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 59
diff changeset
   980
    ^ return
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   981
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   982
    "
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   983
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp 
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 608
diff changeset
   984
     Transcript showCR:(PopUpMenu labels:#('foo' 'bar' 'baz')
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   985
                                  values:#(foo bar baz)) startUp
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   986
    "
281
0f41c95fa722 added method to open menu at a particular position
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   987
1539
fb1366367049 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
   988
    "Created: / 10.1.1996 / 20:11:42 / cg"
fb1366367049 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
   989
    "Modified: / 20.5.1998 / 22:39:03 / cg"
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
   990
!
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
   991
2645
4418d4fb2740 can now specify if menu action is to be performed by
ca
parents: 2644
diff changeset
   992
startUpFor:originatingWidget
4418d4fb2740 can now specify if menu action is to be performed by
ca
parents: 2644
diff changeset
   993
    ^ self startUp
4418d4fb2740 can now specify if menu action is to be performed by
ca
parents: 2644
diff changeset
   994
!
4418d4fb2740 can now specify if menu action is to be performed by
ca
parents: 2644
diff changeset
   995
2173
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   996
startUpOrNil
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   997
    "start the menu modal - return the selected value,
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   998
     or - if no values where specified - return the index.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
   999
     If nothing was selected, return nil.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1000
     Modal - i.e. stay in the menu until finished.
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1001
     This is the ST-80 way of launching a menu."
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1002
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1003
    ^ self startUpAt:nil ifNoneSelected:nil
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1004
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1005
!
3d2395e6cc00 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 2068
diff changeset
  1006
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1007
startUpWithHeading:aString
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1008
    "start the menu modal - return the selected value,
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1009
     or - if no values where specified - return the index.
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1010
     If nothing was selected, return 0.
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1011
     Modal - i.e. stay in the menu until finished.
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1012
     This is the ST-80 way of launching a menu."
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1013
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1014
    |vector|
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1015
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1016
    defaultHideOnRelease := false.
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1017
    (vector := menuView labels) notNil ifTrue:[
4686
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1018
        menuView labels:(Array with:aString with:'=') , vector.
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1019
    ].
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1020
    (vector := menuView selectors) notNil ifTrue:[
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1021
        menuView selectors:#(nil nil) , vector.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1022
    ].
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1023
    (vector := menuView args) notNil ifTrue:[
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1024
        menuView args:#(nil nil) , vector.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1025
    ].
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1026
    (vector := menuView checkFlags) notNil ifTrue:[
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1027
        menuView checkFlags:#(nil nil) , vector.
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1028
    ].
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1029
    (vector := menuView actions) notNil ifTrue:[
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1030
        menuView actions:#(nil nil) , vector.
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1031
    ].
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1032
    menuView disable:1; disable:2.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1033
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1034
    ^ self startUp.
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1035
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1036
    "
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1037
     (PopUpMenu
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1038
        labels:#('foo' 'bar'))
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1039
        startUp
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1040
    "
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1041
    "
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1042
     (PopUpMenu
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1043
        labels:#('foo' 'bar'))
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1044
        startUpWithHeading:'hello'
110
eb59f6e31e84 *** empty log message ***
claus
parents: 105
diff changeset
  1045
    "
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1046
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1047
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1048
!PopUpMenu methodsFor:'accessing-behavior'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1049
3365
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1050
hideOnKeyFilter:aBlock
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1051
    "set a filter, which determines if a key should lead to closing the menu."
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1052
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1053
    hideOnKeyFilter := aBlock
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1054
!
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1055
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1056
hideOnLeave:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1057
    "set/clear the hideOnLeave attribute, which controls
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1058
     if the menu should be hidden when the pointer leaves
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1059
     the view (used with multiple-menus)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1060
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1061
    hideOnLeave := aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1062
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1063
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1064
hideOnRelease:aBoolean
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1065
    "set/clear the hideOnRelease attribute, which controls
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1066
     if the menu should be hidden when the button is released"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1067
335
81c8965c4437 hideOnRelease fixes for COmboBox
Claus Gittinger <cg@exept.de>
parents: 284
diff changeset
  1068
    defaultHideOnRelease := aBoolean.
81c8965c4437 hideOnRelease fixes for COmboBox
Claus Gittinger <cg@exept.de>
parents: 284
diff changeset
  1069
    menuView hideOnRelease:aBoolean
81c8965c4437 hideOnRelease fixes for COmboBox
Claus Gittinger <cg@exept.de>
parents: 284
diff changeset
  1070
81c8965c4437 hideOnRelease fixes for COmboBox
Claus Gittinger <cg@exept.de>
parents: 284
diff changeset
  1071
    "Modified: 9.2.1996 / 02:06:15 / cg"
2433
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1072
!
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1073
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1074
isEnabled:indexOrName
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1075
    "return true, if the item at anIndexOrName is enabled"
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1076
b0523e4aad8a fixed #isEnabled:
Claus Gittinger <cg@exept.de>
parents: 2402
diff changeset
  1077
    ^ menuView isEnabled:indexOrName
4686
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1078
!
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1079
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1080
memorizeLastSelection:index
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1081
    "normally, a popup menu comes up unselected, even if reused.
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1082
     This can be used to arrange for an initial selection to be shown"
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1083
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1084
    lastSelection := index.
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1085
    memorize := true.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1086
! !
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
!PopUpMenu methodsFor:'accessing-items'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1089
3235
422c2db64114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
  1090
addItem:anItem
422c2db64114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
  1091
    menuView addItem:anItem
422c2db64114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
  1092
!
422c2db64114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2946
diff changeset
  1093
4272
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1094
atMenuItemLabeled:aString putSubmenu:aMenu visible:visible
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1095
    |idx|
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1096
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1097
    idx := self indexOf:aString.
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1098
    idx notNil ifTrue:[
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1099
        visible ifTrue:[
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1100
            self subMenuAt:aString put:(aMenu asOldStylePopUpMenuFor:self application).
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1101
        ].
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1102
    ].
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1103
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1104
    "Created: / 30-06-2011 / 10:28:57 / cg"
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1105
!
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1106
4614
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1107
hasItems
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1108
    "return true, if I have items"
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1109
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1110
    ^ menuView notNil and:[ menuView hasItems ]
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1111
!
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1112
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1113
indexOf:indexOrName
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1114
    "return the index of a submenu - or 0 if there is none"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1115
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1116
    ^ menuView indexOf:indexOrName
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1117
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1118
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1119
labels
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1120
    "return the list of labels"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1121
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1122
    actionLabels notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1123
	^ actionLabels asStringCollection
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1124
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1125
    ^ menuView list
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
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1128
labels:labelString lines:lineArrayArg values:valueArray
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1129
    "define the menu the ST-80 way (with labels and lines defined separately)"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1130
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1131
    |lineArray labelArray argArray convertedLabels 
1175
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1132
     offs dstOffs linePos m|
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1133
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1134
    lineArray := lineArrayArg.
3973
6989efdd26ff changed: #labels:lines:values:
Claus Gittinger <cg@exept.de>
parents: 3972
diff changeset
  1135
    (lineArray notNil and:[lineArray first]) == 0 ifTrue:[
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1136
        lineArray := lineArray copyFrom:2.
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1137
    ].
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1138
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1139
    actionLabels := labelString.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1140
    actionLines := lineArray.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1141
    actionValues := valueArray.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1142
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1143
    labelArray := labelString asStringCollection.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1144
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1145
    convertedLabels := Array new:(labelArray size + lineArray size).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1146
    argArray := Array new:(labelArray size + lineArray size).
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1147
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1148
    offs := 1.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1149
    dstOffs := 1.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1150
    1 to:lineArray size do:[:lineIndex |
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1151
        linePos := lineArray at:lineIndex.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1152
        [offs <= linePos] whileTrue:[
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1153
            convertedLabels at:dstOffs put:(labelArray at:offs).
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1154
            argArray at:dstOffs put:offs.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1155
            offs := offs + 1.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1156
            dstOffs := dstOffs + 1
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1157
        ].
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1158
        convertedLabels at:dstOffs put:'-'.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1159
        argArray at:dstOffs put:nil.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1160
        dstOffs := dstOffs + 1
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1161
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1162
    [offs <= labelArray size] whileTrue:[
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1163
        convertedLabels at:dstOffs put:(labelArray at:offs).
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1164
        argArray at:dstOffs put:offs.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1165
        offs := offs + 1.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1166
        dstOffs := dstOffs + 1
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1167
    ].
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1168
1175
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1169
    m := MenuView
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1170
            labels:convertedLabels
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1171
            selectors:nil
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1172
            args:argArray
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1173
            receiver:nil 
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1174
            in:self.
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1175
    m level:0; borderWidth:0.
1175
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1176
    self menuView:m
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1177
9c8aec66cc17 startUp must return 0 if nothing was selected
Claus Gittinger <cg@exept.de>
parents: 1150
diff changeset
  1178
    "Modified: 2.4.1997 / 15:57:52 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1179
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1180
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1181
lines
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1182
    "st-80 compatibility"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1183
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1184
    ^ actionLines
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1185
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1186
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1187
menuAt:indexOrName
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1188
    "return the submenu for entry indexOrName."
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1189
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1190
    ^ self subMenuAt:indexOrName
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1191
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1192
    "Created: 24.3.1996 / 17:11:05 / cg"
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1193
!
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1194
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1195
numberOfItems
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1196
    "return the number of items in the menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1197
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1198
    actionLabels notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1199
	^ actionLabels asStringCollection size
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
    ^ menuView list size
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
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1204
remove:indexOrName
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1205
    "remove a menu entry"
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
    menuView remove:indexOrName
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1208
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1209
518
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1210
subMenuAt:indexOrName
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1211
    "return the submenu for entry indexOrName"
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1212
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1213
    ^ menuView subMenuAt:indexOrName
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1214
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1215
    "Created: 24.3.1996 / 17:09:15 / cg"
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1216
!
731c905a6d89 unified #menuAt/#subMenuAt method names
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1217
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1218
subMenuAt:indexOrName put:aMenu
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1219
    "define a submenu to be shown for entry indexOrName"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1220
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1221
"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1222
    aMenu hideOnLeave:true.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1223
"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1224
    menuView subMenuAt:indexOrName put:aMenu.
5049
7c2d0217f75a class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4905
diff changeset
  1225
    (aMenu notNil and:[aMenu isBlock not]
7c2d0217f75a class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4905
diff changeset
  1226
    ) ifTrue:[
2399
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1227
        "tell the submenu to notify me when action is performed"
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1228
        aMenu superMenu:self.
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1229
    ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1230
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1231
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1232
     |v m someObject|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1233
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1234
     v := View new.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1235
     m := PopUpMenu labels:#('1' '2' '3')
2399
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1236
                 selectors:#(one two nil)
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1237
                  receiver:someObject 
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1238
                       for:nil.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1239
     m subMenuAt:3 put:(PopUpMenu
2399
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1240
                             labels:#('a' 'b' 'c')
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1241
                          selectors:#(a b c)
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1242
                           receiver:someObject 
550e5ab64b82 care for nil arg in #subMenuAt:put:
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
  1243
                                for:nil).
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1244
     v middleButtonMenu:m.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1245
     v realize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1246
    "
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1247
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1248
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1249
values
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1250
    "st-80 compatibility"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1251
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1252
    ^ actionValues
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1253
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1254
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1255
values:aValueArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1256
    "st-80 compatibility"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1257
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1258
    actionValues := aValueArray
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1259
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1260
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1261
!PopUpMenu methodsFor:'accessing-look'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1262
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1263
font:aFont
665
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1264
    "set the menus font.
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1265
     CAVEAT: with the addition of Text objects,
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1266
             this method is going to be obsoleted by a textStyle
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1267
             method, which allows specific control over
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1268
             normalFont/boldFont/italicFont parameters."
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1269
6481
994b339d8f80 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 6244
diff changeset
  1270
    self flushCachedPreferredExtent.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1271
    menuView font:aFont
665
8a8f6e94e1d7 commentary
Claus Gittinger <cg@exept.de>
parents: 655
diff changeset
  1272
6481
994b339d8f80 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 6244
diff changeset
  1273
    "Modified: / 22-05-1996 / 12:36:53 / cg"
994b339d8f80 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 6244
diff changeset
  1274
    "Modified: / 09-11-2018 / 20:17:43 / Claus Gittinger"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1275
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1276
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1277
viewBackground:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1278
    "this is a kludge and will vanish ..."
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1279
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1280
    super viewBackground:aColor.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1281
    menuView viewBackground:aColor
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1282
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1283
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1284
!PopUpMenu methodsFor:'accessing-mvc'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1285
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1286
changeMessage
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1287
    "set the changeMessage from my menu"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1288
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1289
    ^ menuView changeMessage
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1290
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1291
    "Modified: 5.6.1996 / 17:08:52 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1292
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1293
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1294
changeMessage:aSymbol
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1295
    "set the changeMessage - forward to my menu"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1296
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1297
    menuView changeMessage:aSymbol
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1298
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1299
    "Modified: 5.6.1996 / 17:08:41 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1300
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1301
962
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1302
menuPerformer
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1303
    "get the menuPerformer - forwarded to my menuViews"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1304
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1305
    ^ menuView menuPerformer
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1306
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1307
    "Modified: 5.6.1996 / 17:08:30 / cg"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1308
    "Created: 21.1.1997 / 15:40:22 / cg"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1309
!
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1310
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1311
menuPerformer:someone
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1312
    "set the menuPerformer - forwarded to my menuViews"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1313
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1314
    menuView menuPerformer:someone
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1315
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1316
    "Modified: 5.6.1996 / 17:08:30 / cg"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1317
    "Created: 21.1.1997 / 15:40:14 / cg"
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1318
!
1f1033090efe menuPerformer messages down
Claus Gittinger <cg@exept.de>
parents: 959
diff changeset
  1319
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1320
model 
753
40b85851bffb comment
Claus Gittinger <cg@exept.de>
parents: 726
diff changeset
  1321
    "return my menuViews model"
40b85851bffb comment
Claus Gittinger <cg@exept.de>
parents: 726
diff changeset
  1322
40b85851bffb comment
Claus Gittinger <cg@exept.de>
parents: 726
diff changeset
  1323
    ^ menuView model
40b85851bffb comment
Claus Gittinger <cg@exept.de>
parents: 726
diff changeset
  1324
40b85851bffb comment
Claus Gittinger <cg@exept.de>
parents: 726
diff changeset
  1325
    "Modified: 5.6.1996 / 14:16:53 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1326
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1327
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1328
model:aModel
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1329
    "set the model - forwarded to my menuViews"
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1330
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1331
    menuView model:aModel
754
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1332
4db5b854cc88 comment
Claus Gittinger <cg@exept.de>
parents: 753
diff changeset
  1333
    "Modified: 5.6.1996 / 17:08:30 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1334
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1335
4272
2023eba96b06 added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 4025
diff changeset
  1336
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1337
!PopUpMenu methodsFor:'deactivation'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1338
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1339
hide
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1340
    "hide the menu - if there are any pop-up-submenus, hide them also"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1341
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1342
    menuView hideSubmenu.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1343
    super hide.
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1344
    (self isOpenedAsSubmenu) ifTrue:[
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1345
        menuView superMenu regainControl
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1346
    ].
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1347
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1348
    "Modified: 25.2.1997 / 22:11:53 / cg"
2068
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1349
!
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1350
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1351
hideForAction
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1352
    "hide the menu - if there are any pop-up-submenus, hide them also.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1353
     Any superMenu is not asked to regain control, since we are going to
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1354
     hide them also."
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1355
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1356
    menuView hideSubmenu.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1357
    super hide.
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1358
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1359
2038
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1360
!PopUpMenu methodsFor:'dummy'!
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1361
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1362
findGuiResourcesIn:aResourceContainerOrApplication
6244
a24a9a3fbc7f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5636
diff changeset
  1363
    "dummy - for compatibility with MenuPanel 
a24a9a3fbc7f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5636
diff changeset
  1364
     (in case an old-style PopUpMenu is returned from a menu message)"
2038
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1365
6244
a24a9a3fbc7f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5636
diff changeset
  1366
    "/ intentionally left blank
2038
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1367
! !
065ced8a481f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1368
70
14443a9ea4ec *** empty log message ***
claus
parents: 63
diff changeset
  1369
!PopUpMenu methodsFor:'event handling'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1370
161
claus
parents: 137
diff changeset
  1371
buttonMotion:state x:x y:y
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1372
    |p sensor|
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1373
3913
f15213240dde preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3594
diff changeset
  1374
    "/ state == 0 ifTrue:[^ self].
1623
1fde415aabf3 ignore motion event if no button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1606
diff changeset
  1375
1150
ce8842029d20 care for late motion events
Claus Gittinger <cg@exept.de>
parents: 1057
diff changeset
  1376
    (sensor := self sensor) isNil ifTrue:[^ self].
3913
f15213240dde preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3594
diff changeset
  1377
    (sensor hasButtonMotionEventFor:self) ifTrue:[^ self].
f15213240dde preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3594
diff changeset
  1378
1623
1fde415aabf3 ignore motion event if no button is pressed.
Claus Gittinger <cg@exept.de>
parents: 1606
diff changeset
  1379
    "any-button ?"
3913
f15213240dde preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3594
diff changeset
  1380
    "/ sensor anyButtonPressed ifFalse:[^ self].
161
claus
parents: 137
diff changeset
  1381
1859
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1382
    ((x >= 0) 
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1383
    and:[x < width
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1384
    and:[y >= 0
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1385
    and:[y < height]]]) ifTrue:[
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1386
        "/ inside me
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1387
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1388
        (x >= margin 
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1389
        and:[x < (width-margin)
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1390
        and:[y >= margin
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1391
        and:[y < (height-margin)]]]) ifTrue:[
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1392
            "/ inside my menuView
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1393
            hideOnRelease := true.
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
  1394
            p := device 
2434
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1395
                    translatePoint:(x @ y)
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1396
                    fromView:self
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1397
                    toView:menuView.
1859
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1398
        
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1399
            menuView buttonMotion:state x:p x y:p y.
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1400
        ].
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1401
        ^ self
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1402
    ].
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1403
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1404
    "outside of myself"
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1405
    (self isOpenedAsSubmenu) ifTrue:[
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
  1406
        p := device 
2434
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1407
                translatePoint:(x @ y)
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1408
                fromView:self
a9b9d8f2ab5b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
  1409
                toView:(menuView superMenu).
3493
41479ea9a052 changed #buttonMotion:x:y:
Claus Gittinger <cg@exept.de>
parents: 3365
diff changeset
  1410
        p notNil ifTrue:[
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1411
            menuView superMenu buttonMotion:state x:p x y:p y
3493
41479ea9a052 changed #buttonMotion:x:y:
Claus Gittinger <cg@exept.de>
parents: 3365
diff changeset
  1412
        ]
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1413
    ].
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1414
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1415
    menuView subMenuShown isNil ifTrue:[
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1416
        menuView pointerLeave:state.
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1417
    ].
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1418
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1419
    hideOnLeave ifTrue:[
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1420
        self hide
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
  1421
    ].
1057
220f818b0577 ignore motions if more are pending
Claus Gittinger <cg@exept.de>
parents: 1056
diff changeset
  1422
3493
41479ea9a052 changed #buttonMotion:x:y:
Claus Gittinger <cg@exept.de>
parents: 3365
diff changeset
  1423
    "Modified: / 28-07-2007 / 13:14:12 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1424
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1425
105
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1426
buttonPress:button x:x y:y
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1427
    hideOnRelease := true.
967
6739eb5496da commentary
Claus Gittinger <cg@exept.de>
parents: 962
diff changeset
  1428
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1429
    ((x >= 0) and:[x < width]) ifTrue:[
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1430
        ((y >= 0) and:[y < height]) ifTrue:[
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1431
            menuView buttonPress:button x:x y:y.
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1432
            ^ self
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1433
        ]
105
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1434
    ].
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1435
967
6739eb5496da commentary
Claus Gittinger <cg@exept.de>
parents: 962
diff changeset
  1436
    "Modified: 22.1.1997 / 17:38:14 / cg"
105
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1437
!
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1438
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1439
buttonRelease:button x:x y:y
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1440
    |h|
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1441
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1442
    realized ifFalse:[^ self].
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1443
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1444
    "/
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1445
    "/ detect short click - stay open if this is one
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1446
    "/
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1447
    h := hideOnRelease.
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1448
    (OperatingSystem 
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1449
        millisecondTimeDeltaBetween:(Time millisecondClockValue)
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1450
                                and:mapTime) > (self class maxClickTimeToStayOpen) ifFalse:[
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1451
        hideOnRelease := false.
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1452
    ].
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1453
105
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1454
    hideOnRelease ifFalse:[
425
9d44d3ff44a0 avoid recursion trouble
Claus Gittinger <cg@exept.de>
parents: 406
diff changeset
  1455
        ^ self
105
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1456
    ].
3d064ba4a0cc *** empty log message ***
claus
parents: 96
diff changeset
  1457
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1458
    (x < 0 
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1459
    or:[x >= width
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1460
    or:[y < 0
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1461
    or:[y >= height]]]) ifTrue:[
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1462
         "/   
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1463
         "/ released outside of mySelf
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1464
         "/
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1465
        (self isOpenedAsSubmenu) ifTrue:[
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1466
            menuView superMenu hideSubmenu
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1467
        ] ifFalse:[
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1468
            self hide
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1469
        ].
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1470
        ^ self
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1471
    ].
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1472
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1473
465
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
  1474
"/    menuView superMenu notNil ifTrue:[
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
  1475
"/        menuView superMenu submenuTriggered 
b473edeab54e can now be controlled by keyboard
Claus Gittinger <cg@exept.de>
parents: 459
diff changeset
  1476
"/    ].
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1477
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1478
    menuView buttonRelease:button x:x y:y.
425
9d44d3ff44a0 avoid recursion trouble
Claus Gittinger <cg@exept.de>
parents: 406
diff changeset
  1479
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1480
    "Modified: 8.3.1996 / 14:17:18 / cg"
112
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
  1481
!
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
  1482
81633ba1bf40 *** empty log message ***
claus
parents: 110
diff changeset
  1483
keyPress:key x:x y:y
491
7b376aaa06d5 resources
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1484
    <resource: #keyboard (#Tab)>
7b376aaa06d5 resources
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1485
3365
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1486
    hideOnKeyFilter notNil ifTrue:[
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1487
        (hideOnKeyFilter value:key) ifTrue:[
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1488
            self hide.
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1489
            ^ self.
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1490
        ].
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1491
    ].
425
9d44d3ff44a0 avoid recursion trouble
Claus Gittinger <cg@exept.de>
parents: 406
diff changeset
  1492
348
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1493
    key == #Tab ifTrue:[
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1494
        self hide.
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1495
        super keyPress:key x:x y:y.
3365
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1496
        ^ self.
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1497
    ].
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1498
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1499
    x == 0 ifTrue:[
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1500
        menuView keyPress:key x:nil y:nil.
348
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1501
    ] ifFalse:[
3365
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1502
        x notNil ifTrue:[
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1503
            "/ already redelegated
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1504
            menuView keyPress:key x:x y:y.
efa2c707567a +hideOnKeyFilter
Claus Gittinger <cg@exept.de>
parents: 3235
diff changeset
  1505
        ].
348
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1506
    ].
2925bbd4f346 dont forward Tab to pulled views
Claus Gittinger <cg@exept.de>
parents: 342
diff changeset
  1507
1408
61d42fa7dafd care for recursive redelegation
Claus Gittinger <cg@exept.de>
parents: 1404
diff changeset
  1508
    "Modified: / 6.12.1997 / 01:53:08 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1509
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1510
342
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1511
mapped
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1512
    super mapped.
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1513
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1514
    "/
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1515
    "/ check if a button is pressed when mapped;
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1516
    "/ if not, change my hide-strategy
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1517
    "/
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1518
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1519
"/    device buttonStates == 0 ifTrue:[
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1520
"/        hideOnRelease := false
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1521
"/    ].
342
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1522
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1523
    "Created: 9.2.1996 / 19:56:20 / cg"
497
072d3b8507fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1524
    "Modified: 8.3.1996 / 13:42:15 / cg"
342
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1525
!
ddbe4e8d6e9f check if buttons are down at map-time; change release behavior, if no button is pressed then
Claus Gittinger <cg@exept.de>
parents: 335
diff changeset
  1526
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1527
pointerEnter:state x:x y:y
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1528
    "catch quick release of button"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1529
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1530
    hideOnLeave ifTrue:[
1859
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1531
        state == 0 ifTrue:[
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1532
            self hide
acd3ca6d027b do not forward motion-events if within my margin.
Claus Gittinger <cg@exept.de>
parents: 1623
diff changeset
  1533
        ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1534
    ]
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1535
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1536
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1537
pointerLeave:state
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1538
"/    menuView pointerLeave:state.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1539
"/    hideOnLeave ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1540
"/        self hide
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1541
"/    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1542
"/    menuView superMenu notNil ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1543
"/        menuView superMenu regainControl
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1544
"/    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1545
! !
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1546
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1547
!PopUpMenu methodsFor:'initialization'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1548
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1549
initEvents
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1550
    super initEvents.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1551
    self enableEnterLeaveEvents.
3913
f15213240dde preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3594
diff changeset
  1552
    self enableMotionEvents.
495
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1553
d993f23ea658 fixed subMenus with a menuPerformer (now also behaves the ST-80 way)
Claus Gittinger <cg@exept.de>
parents: 491
diff changeset
  1554
    "Modified: 7.3.1996 / 14:17:42 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1555
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1556
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1557
initStyle
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1558
    <resource: #style (#'popup.hideOnRelease'
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1559
                       #'popup.level'
4025
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1560
"/                       #'popup.borderWidth'
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1561
"/                       #'popup.borderColor'
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1562
                       )>
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1563
4025
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1564
    |lvl bw bc|
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1565
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1566
    super initStyle.
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1567
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1568
    (lvl := styleSheet at:#'popup.level') notNil ifTrue:[
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1569
        self level:lvl.
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1570
    ].
4025
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1571
"/    (bw := styleSheet at:#'popup.borderWidth') notNil ifTrue:[
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1572
"/        self borderWidth:bw
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1573
"/    ].
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1574
"/    (bc := styleSheet at:#'popup.borderColor') notNil ifTrue:[
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1575
"/        self borderColor:bc
9bab54a59ebe borderColor from styleSheet
Claus Gittinger <cg@exept.de>
parents: 3979
diff changeset
  1576
"/    ].
2655
3648be6af751 time constant for hideOnRelease shared with MenuPanel
Claus Gittinger <cg@exept.de>
parents: 2645
diff changeset
  1577
    defaultHideOnRelease := styleSheet at:#'popup.hideOnRelease' default:true.
1861
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1578
!
a582b6c0809d take level & borderWidth from popup.level and
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1579
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1580
initialize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1581
    super initialize.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1582
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1583
    memorize := true.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1584
    hideOnLeave := false.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1585
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1586
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1587
!PopUpMenu methodsFor:'menuview messages'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1588
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1589
doesNotUnderstand:aMessage
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1590
    "forward all menu-view messages"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1591
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1592
    (menuView respondsTo:(aMessage selector)) ifTrue:[
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1593
	^ aMessage sendTo:menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1594
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1595
    ^ super doesNotUnderstand:aMessage
1404
1085b9e9fb09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
  1596
!
1085b9e9fb09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
  1597
1085b9e9fb09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
  1598
regainControl
2068
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1599
|g|
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
  1600
    ((g := device activePointerGrab) ~~ self) ifTrue:[
2068
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1601
        self forceUngrabPointer.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1602
        self forceUngrabKeyboard.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1603
        shown ifTrue:[
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1604
            self grabPointer.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1605
            self grabKeyboard.
302847f5d01d grabbing changed to restore grab at hiding time,
ca
parents: 2067
diff changeset
  1606
        ]
1442
7dfbc21dfdc6 Avoid pointer and keyboard grabbing if not necessary
Stefan Vogel <sv@exept.de>
parents: 1408
diff changeset
  1607
    ].
1404
1085b9e9fb09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1403
diff changeset
  1608
1442
7dfbc21dfdc6 Avoid pointer and keyboard grabbing if not necessary
Stefan Vogel <sv@exept.de>
parents: 1408
diff changeset
  1609
    "Modified: / 20.11.1997 / 00:32:32 / cg"
7dfbc21dfdc6 Avoid pointer and keyboard grabbing if not necessary
Stefan Vogel <sv@exept.de>
parents: 1408
diff changeset
  1610
    "Modified: / 2.2.1998 / 23:52:28 / stefan"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1611
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1612
2742
c5614cbcd83d method category rename
Claus Gittinger <cg@exept.de>
parents: 2716
diff changeset
  1613
!PopUpMenu methodsFor:'private-accessing'!
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1614
3972
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1615
isOpenedAsSubmenu
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1616
    "return true, if I have been opened as a submenu of some other
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1617
     menu."
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1618
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1619
    |superMenu|
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1620
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1621
    superMenu := menuView superMenu.
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1622
    "/ check for realized, because the CTRL/SHIFT menus of a textView
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1623
    "/ are opened as top-menu AND have a non-nil supermenu.
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1624
    "/ thus asking for supermenu being nonNil is NOT a sufficient indicator for
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1625
    "/ being an open submenu !!
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1626
    ^ superMenu notNil and:[superMenu realized]
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1627
!
810842932c33 added: #isOpenedAsSubmenu
Claus Gittinger <cg@exept.de>
parents: 3965
diff changeset
  1628
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1629
menu:aMenuView
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1630
    "set the actual menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1631
2367
6e23afd01cbd Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 2173
diff changeset
  1632
    <resource:#obsolete>
6e23afd01cbd Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 2173
diff changeset
  1633
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1634
    self obsoleteMethodWarning:'use #menuView:'.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1635
    self menuView:aMenuView
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1636
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1637
    "Modified: 25.2.1997 / 20:52:08 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1638
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1639
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1640
menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1641
    "return the actual menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1642
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1643
    ^ menuView
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1644
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1645
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1646
menuView:aMenu
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1647
    "set the actual menu"
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1648
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1649
    menuView := aMenu.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1650
    menuView origin:(margin @ margin).
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1651
    menuView borderWidth:0.
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1652
    menuView masterView:self
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1653
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1654
    "Created: 25.2.1997 / 20:51:42 / cg"
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1655
!
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1656
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1657
superMenu:aMenu
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1658
    "set the superMenu"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1659
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1660
    menuView superMenu:aMenu
1056
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1661
ef4c9dc26b37 #menu: -> #menuView:
Claus Gittinger <cg@exept.de>
parents: 967
diff changeset
  1662
    "Modified: 25.2.1997 / 20:52:20 / cg"
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1663
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1664
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1665
!PopUpMenu methodsFor:'realization'!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1666
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1667
fixSize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1668
    "called right before the view is made visible.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1669
     adjust my size to the size of the actual menu"
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1670
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1671
    |extra newWidth newHeight|
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1672
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1673
    extra := margin * 2.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1674
    menuView resizeIfChanged.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1675
    newWidth := menuView width + extra.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1676
    newHeight := menuView height + extra.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1677
    ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
2716
0879949e0c7e code cleanup
Claus Gittinger <cg@exept.de>
parents: 2656
diff changeset
  1678
        self extent:(newWidth @ newHeight)
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1679
    ].
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1680
    super fixSize
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1681
!
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1682
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1683
realize
4686
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1684
    (memorize == true and:[lastSelection notNil]) ifTrue:[
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1685
        menuView setSelection:lastSelection.
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1686
    ] ifFalse:[
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1687
        menuView deselectWithoutRedraw.
4af1a7c70580 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4685
diff changeset
  1688
    ].
202
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1689
    super realize.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1690
    hideOnRelease := defaultHideOnRelease.
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1691
! !
01f3cbb8e20e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
  1692
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1693
!PopUpMenu class methodsFor:'documentation'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1694
4614
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1695
version
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
  1696
    ^ '$Header$'
4614
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1697
!
4deb539efcb7 isEmpty -> hasItems
Claus Gittinger <cg@exept.de>
parents: 4612
diff changeset
  1698
3965
9a999e1c9e5e changed:
Claus Gittinger <cg@exept.de>
parents: 3913
diff changeset
  1699
version_CVS
5636
a5c74a5a7497 device access
Claus Gittinger <cg@exept.de>
parents: 5253
diff changeset
  1700
    ^ '$Header$'
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 202
diff changeset
  1701
! !
4544
84d2e978b4e2 class: PopUpMenu
Claus Gittinger <cg@exept.de>
parents: 4400
diff changeset
  1702