Menu.st
author Claus Gittinger <cg@exept.de>
Fri, 23 May 2014 09:19:21 +0200
changeset 3340 96d5a7df1639
parent 3254 8c2680e496c9
child 3355 214c2aa60193
permissions -rw-r--r--
class: Menu added: #atNameKey:ifPresentDo:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1354
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     1
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     2
 COPYRIGHT (c) 1997 by eXept Software AG
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     3
              All Rights Reserved
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     4
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     5
 This software is furnished under a license and may be used
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     6
 only in accordance with the terms of that license and with the
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     8
 be provided or otherwise made available to, or used by, any
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
     9
 other person.  No title to or ownership of the software is
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    10
 hereby transferred.
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    11
"
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
    12
"{ Package: 'stx:libview2' }"
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
    13
2854
d37c539b59ad inherit from model, for cheap dependents.
Claus Gittinger <cg@exept.de>
parents: 2814
diff changeset
    14
Model subclass:#Menu
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    15
	instanceVariableNames:'items groupSizes receiver'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	category:'Views-Support'
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
1354
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    23
copyright
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    24
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    25
 COPYRIGHT (c) 1997 by eXept Software AG
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    26
              All Rights Reserved
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    27
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    28
 This software is furnished under a license and may be used
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    29
 only in accordance with the terms of that license and with the
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    31
 be provided or otherwise made available to, or used by, any
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    32
 other person.  No title to or ownership of the software is
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    33
 hereby transferred.
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    34
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    35
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    36
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    37
!
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    38
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
documentation
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    not yet finished Menu class - this will eventually replace
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    most of the MenuView and PopUpMenu stuff.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    (and hopefully be ST-80 compatible ...)
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    For now, only a subset of the full protocol is implemented.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    [author:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    48
	Claus Gittinger
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    [see also:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    51
	MenuItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    52
	PopUpMenu
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    56
!Menu class methodsFor:'instance creation'!
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    57
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    58
labelArray:arrayOfString lines:linesArray values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    59
    "return a menu with menu items built with labels from arrayOfString (not Symbols).  
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    60
     The linesArray describes which menu items are the last menu item in their group. 
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    61
     The valueArray contains value objects for each menu item 
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    62
     (or is nil if no value objects are specified)."
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    63
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    64
    |nLabel valueArray menuItems groupLengths|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    65
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    66
    nLabel := arrayOfString size.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    67
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    68
    valueArrayOrNil isNil ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    69
        (valueArray := arrayOfString isEmpty) ifTrue: [
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    70
            valueArray := #()
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    71
        ] ifFalse:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    72
            valueArray := (1 to:nLabel)
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    73
        ]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    74
    ] ifFalse:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    75
        valueArray := valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    76
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    77
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    78
    nLabel ~~ valueArray size ifTrue: [
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    79
        ^ self error: 'illegal menu combination'
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    80
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    81
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    82
    menuItems := Array new:nLabel.
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    83
    1 to:nLabel do:[:i |
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    84
        |mi v|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    85
3222
2bc1eca23bd7 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3185
diff changeset
    86
        mi := MenuItem label:(arrayOfString at:i) asString.
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    87
        v := valueArray at:i.
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    88
        (v isKindOf:Menu) ifTrue:[mi submenu:v].
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    89
        menuItems at:i put:mi
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    90
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    91
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    92
    (linesArray size == 0) ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    93
        groupLengths := (menuItems isEmpty)
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    94
                            ifTrue: [Array new:0]
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    95
                            ifFalse: [Array with:menuItems size]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    96
    ] ifFalse:[
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    97
        groupLengths := Array new:(linesArray size + 1).
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    98
        groupLengths at:1 put:linesArray first.
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    99
        2 to:linesArray size do: [:i | 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   100
            groupLengths at:i put:((linesArray at:i) - (linesArray at:i - 1))
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   101
        ].
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   102
        groupLengths at:groupLengths size put:(menuItems size - linesArray last).
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   103
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   104
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   105
    ^ self new 
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   106
        menuItems:menuItems 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   107
        menuItemGroups:groupLengths 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   108
        values:valueArray
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   109
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   110
    "Modified: / 19.4.1998 / 11:30:18 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   111
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   112
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   113
labelArray:arrayOfString values:valueArrayOrNil
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   114
    "return a menu with menu items built with labels from arrayOfString (not Symbols).  
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   115
     The valueArray contains value objects for each menu item 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   116
     (or is nil if no value objects are specified)."
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   117
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   118
    ^ self 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   119
        labelArray:arrayOfString 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   120
        lines:nil 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   121
        values: valueArrayOrNil
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   122
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   123
!
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   124
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   125
labelList:arrayOfGroupStrings values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   126
    |labels lines|
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   127
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   128
    lines := arrayOfGroupStrings collect:[:each | each size].
2017
0cdc1c537fa0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
   129
    labels := arrayOfGroupStrings collectAll:[:eachGroup | eachGroup].
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   130
    ^ self labelArray:labels lines:lines values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   131
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   132
    "Modified: 20.6.1997 / 10:46:45 / cg"
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   133
    "Created: 13.9.1997 / 10:35:46 / cg"
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   134
!
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   135
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   136
labels:aString lines:linesArray values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   137
    ^ self 
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   138
	labelArray:(aString asCollectionOfLines)
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   139
	lines:linesArray
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   140
	values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   141
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   142
    "Created: / 31.10.1997 / 03:12:20 / cg"
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   143
    "Modified: / 31.10.1997 / 03:23:42 / cg"
1525
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   144
!
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   145
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   146
labels:aString values:valueArrayOrNil
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   147
    ^ self 
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   148
        labelArray:(aString asCollectionOfLines)
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   149
        lines:#()
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   150
        values:valueArrayOrNil
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   151
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   152
    "Modified: / 31.10.1997 / 03:23:42 / cg"
9008957b8ff7 compatibility
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   153
    "Created: / 12.11.2001 / 16:06:36 / cg"
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   154
! !
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   155
1764
caf114053269 method category rename
Claus Gittinger <cg@exept.de>
parents: 1758
diff changeset
   156
!Menu methodsFor:'Compatibility-ST80'!
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   157
2126
79be7625f40f addLine: VW7 compat.
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
   158
addLine
79be7625f40f addLine: VW7 compat.
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
   159
    self addSeparator
79be7625f40f addLine: VW7 compat.
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
   160
!
79be7625f40f addLine: VW7 compat.
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
   161
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   162
indexOfMenuItem:anItem
2433
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   163
    ^ items indexOf:anItem
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   164
2433
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   165
    "Created: / 27.10.1997 / 16:34:19 / cg"
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   166
!
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   167
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   168
indexOfMenuItemForWhich:aBlock
632122b652eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2404
diff changeset
   169
    ^ items findFirst:aBlock
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   170
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   171
    "Created: / 27.10.1997 / 16:34:19 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   172
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   173
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   174
menuButtons
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   175
    "ST-80 seems to use a special menuButton class here.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   176
     Here, kludge a collection of menuItems."
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   177
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   178
    ^ items
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   179
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   180
    "Created: / 27.10.1997 / 16:33:35 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   181
! !
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   182
1782
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   183
!Menu methodsFor:'Compatibility-Squeak'!
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   184
2764
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   185
add:label target:target selector:selector
3185
0d09b958253d class: Menu
Claus Gittinger <cg@exept.de>
parents: 3117
diff changeset
   186
    self addItem:(MenuItem label:label itemValue:[target perform:selector]).
2764
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   187
!
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   188
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   189
balloonTextForLastItem:aString
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   190
    items last helpText:aString
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   191
!
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   192
1782
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   193
labels:labels lines:lines selections:selections
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   194
    |labelArray|
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   195
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   196
    labels isString ifTrue:[
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   197
        labelArray := labels asCollectionOfLines.
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   198
    ] ifFalse:[
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   199
        labelArray := labels.
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   200
    ].
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   201
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   202
    1 to:labelArray size do:[:idx |
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   203
        |item|
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   204
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   205
        item := MenuItem new.
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   206
        item label:(labelArray at:idx).
3022
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   207
        item itemValue:(selections at:idx).
1782
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   208
        self addItem:item.
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   209
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   210
        (lines includes:idx) ifTrue:[
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   211
            self addSeparator.
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   212
        ].
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   213
    ].
3022
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   214
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   215
    "Modified: / 09-09-2012 / 13:08:55 / cg"
1782
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   216
! !
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   217
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
!Menu methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
2916
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   220
atMenuItemLabeled:aString putSubmenu:aMenu visible:visible
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   221
    (self menuItemLabeled:aString)
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   222
        submenu:aMenu;
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   223
        isVisible:visible
2916
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   224
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   225
    "Created: / 30-06-2011 / 10:30:22 / cg"
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   226
!
ff96b6187a5f added: #atMenuItemLabeled:putSubmenu:visible:
Claus Gittinger <cg@exept.de>
parents: 2908
diff changeset
   227
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   228
atNameKey:aNameKey
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   229
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   230
     Searches in allItems (i.e. also in subMenus)"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   231
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   232
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   233
	anItem nameKey == aNameKey ifTrue:[^ anItem]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   234
    ].
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   235
    ^ nil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   236
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   237
    "Modified: / 27.10.1997 / 15:12:00 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   238
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   239
3340
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   240
atNameKey:aNameKey ifPresentDo:aBlock
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   241
    "look for a menuItem withthe given nameKey. If one is found, aBlock is evaluated for it.
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   242
     If not, nothing is done.
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   243
     Searches in allItems (i.e. also in subMenus).
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   244
     Returns the item or nil."
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   245
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   246
    |item|
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   247
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   248
    (item := self atNameKey:aNameKey) notNil ifTrue:[
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   249
        aBlock value:item.
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   250
    ].
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   251
    ^ item
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   252
!
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
   253
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   254
groupSizes
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   255
    ^ groupSizes
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   256
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   257
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   258
groupSizes:something
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   259
    groupSizes := something.
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   260
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   261
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   262
items
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   263
    ^ items
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   264
!
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   265
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   266
labelAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   267
    "gets the label of the menu item at the given index or nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   268
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   269
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   270
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   271
    (item := self menuItemAt:anIndex) notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   272
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   273
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   274
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   275
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   276
    "Modified: / 2.2.1998 / 13:28:32 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   277
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   278
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   279
labelAtValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   280
    "gets the label of the menu item assigned to value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   281
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   282
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   283
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   284
    item := self menuAndSubmenusDetectItem:[:anItem | anItem value == aValue ].
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   285
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   286
    item notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   287
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   288
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   289
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   290
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   291
    "Modified: / 2.2.1998 / 13:28:28 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   292
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   293
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
labels
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
    "return a collection of labels from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   297
    items isNil ifTrue:[^ #()].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
    ^ items collect:[:anItem | anItem label]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   300
    "Created: / 25.2.1997 / 19:47:53 / cg"
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   301
    "Modified: / 19.6.1998 / 02:36:22 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   304
lastItem
2584
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   305
    "returns the last item or nil, if there are none"
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   306
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   307
    ^ items isEmptyOrNil 
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   308
        ifTrue:[nil]
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   309
        ifFalse:[items last]
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   310
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   311
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   312
lines
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   313
    "return the indexes of the menu items that are the last menu item in their group (except the very last)."
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   314
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   315
    |lines groupSz|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   316
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   317
    (groupSz := groupSizes size) <= 1 ifTrue: [^ Array new].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   318
    lines := Array new:(groupSz - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   319
    lines at:1 put:groupSizes first.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   320
    2 to:(groupSz-1) do:[:i |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   321
        lines at:i put:(lines at:(i - 1)) + (groupSizes at:i)
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   322
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   323
    ^ lines
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   324
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   325
    "Modified: / 2.2.1998 / 13:28:19 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   326
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   327
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   328
menuItemAt:index 
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   329
    "gets the menu item at the given index. When the index is out of bounds
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   330
     nil is returned"
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   331
    
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   332
    (index > 0 and:[ index <= items size ]) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   333
        ^ items at:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   334
    ].
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   335
    ^ nil
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   336
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   337
    "Modified: / 30-06-2011 / 10:51:39 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   338
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   339
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   340
menuItemLabeled:anItemLabel 
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   341
    "return the menuItem for the given nameKey; nil if no such item is in the menu.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   342
     Searches all items (i.e. also submenu items)"
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   343
    
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   344
    self 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   345
        allItemsDo:[:anItem | 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   346
            |l|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   347
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   348
            ((l := anItem label) sameAs:anItemLabel) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   349
                ^ anItem
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   350
            ].
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   351
            (l includes:$&) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   352
                ((l copyWithout:$&) sameAs:anItemLabel) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   353
                    ^ anItem
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   354
                ]
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   355
            ]
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   356
        ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   357
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   358
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   359
    "Created: / 13-09-1997 / 10:25:16 / cg"
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   360
    "Modified: / 30-06-2011 / 10:51:44 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   361
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   362
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   363
menuItemWithArgument:aValue 
2908
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   364
    "return the menuItem for the given value; nil if no such item is in the menu.
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   365
     Searches all items (i.e. also submenu items)"
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   366
    
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   367
    self 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   368
        allItemsDo:[:anItem | 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   369
            |l|
2908
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   370
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   371
            (anItem argument = aValue) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   372
                ^ anItem
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   373
            ].
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   374
        ].
2908
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   375
    ^ nil
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   376
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   377
    "Created: / 19-04-2011 / 14:42:18 / cg"
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   378
    "Modified: / 30-06-2011 / 10:51:50 / cg"
2908
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   379
!
e21010b76553 added: #menuItemWithArgument:
Claus Gittinger <cg@exept.de>
parents: 2867
diff changeset
   380
2952
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   381
menuItemWithKey:aValue 
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   382
    "return the menuItem for the given key; nil if no such item is in the menu.
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   383
     Searches all items (i.e. also submenu items)"
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   384
    
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   385
    self 
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   386
        allItemsDo:[:anItem | 
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   387
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   388
            (anItem nameKey = aValue) ifTrue:[
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   389
                ^ anItem
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   390
            ].
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   391
        ].
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   392
    ^ nil
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   393
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   394
    "Created: / 19-04-2011 / 14:42:18 / cg"
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   395
    "Modified: / 30-06-2011 / 10:51:50 / cg"
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   396
    "Created: / 07-10-2011 / 15:04:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   397
!
1cedbbc95433 added: #menuItemWithKey:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2918
diff changeset
   398
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   399
menuItemWithValue:aValue 
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   400
    "return the menuItem for the given value; nil if no such item is in the menu.
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   401
     Searches all items (i.e. also submenu items)"
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   402
    
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   403
    self 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   404
        allItemsDo:[:anItem | 
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   405
            |l|
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   406
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   407
            (anItem value == aValue) ifTrue:[
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   408
                ^ anItem
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   409
            ].
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   410
        ].
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   411
    ^ nil
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   412
2918
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   413
    "Created: / 13-09-1997 / 10:25:16 / cg"
44a68f3ffba5 fixes for Jan's menu rewriting in NewSystemBrowser
Claus Gittinger <cg@exept.de>
parents: 2917
diff changeset
   414
    "Modified: / 30-06-2011 / 10:51:56 / cg"
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   415
!
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   416
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   417
menuItems
1327
b0b482a84570 menuItems always returns a collection (never nil)
Claus Gittinger <cg@exept.de>
parents: 1308
diff changeset
   418
    ^ items ? #()
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   419
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   420
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   421
menuItems:aCollectionOfMenuItems menuItemGroups:sizes values:values
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   422
    |n|
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   423
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   424
    items := groupSizes := nil.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   425
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   426
    aCollectionOfMenuItems size == 0 ifTrue:[ ^ self ].
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   427
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
    items := aCollectionOfMenuItems.
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   429
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   430
    sizes size > 0 ifTrue:[
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   431
        groupSizes := sizes.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   432
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   433
        n := sizes inject:0 into:[:sumSoFar :this | sumSoFar + this].
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   434
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   435
        n = items size ifTrue:[
3117
3c7f6b69b2c5 Changed usage of deprecated #copyWithoutLast: to #copyButLast:
Stefan Vogel <sv@exept.de>
parents: 3028
diff changeset
   436
            groupSizes := sizes copyButLast:1
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   437
        ]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   438
    ].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   440
    values notNil ifTrue:[
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   441
        items with:values do:[:anItem :aValue |anItem value:aValue]
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   442
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   443
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   444
    "Modified: / 19.4.1998 / 11:47:34 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
1116
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   447
menuPerformer:something
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   448
    "set the receiver of the menu messages"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   449
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   450
    receiver := something.
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   451
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   452
    "Modified: / 2.2.1998 / 13:26:29 / cg"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   453
!
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   454
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   455
numberOfItems
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   456
    "return the number of items in this menu"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   457
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   458
    ^ items size
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   459
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   460
    "Created: / 6.3.1997 / 15:15:53 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   461
    "Modified: / 2.2.1998 / 13:26:40 / cg"
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   462
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   463
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   464
receiver
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   465
    "return the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   466
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   467
    ^ receiver
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   468
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   469
    "Modified: / 2.2.1998 / 13:26:20 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   470
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   471
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   472
receiver:something
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   473
    "set the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   474
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   475
    receiver := something.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   476
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   477
    "Modified: / 2.2.1998 / 13:26:29 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   478
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   479
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
valueAt:index
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
    ^ (items at:index) value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
    "Created: 25.2.1997 / 19:49:41 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   488
valueAt:anIndex put:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   489
    "put value an an index"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   490
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   491
    (items at:anIndex) value:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   492
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   493
    "Created: 6.3.1997 / 15:15:48 / cg"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   494
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   495
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
values
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
    ^ items collect:[:anItem | anItem value]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
    "Created: 25.2.1997 / 19:49:29 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   502
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   503
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   504
values:aCollectionOfValues
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   505
    "return a collection of values from my items"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   506
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   507
    |s|
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   508
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   509
    s := aCollectionOfValues readStream.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   510
    self itemsDo:[:item |
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   511
        |val|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   512
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   513
        val := s next.
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   514
        item value:val
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   515
    ].
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   516
    s atEnd ifFalse:[
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   517
        self error:'not enough elements in the value collection' mayProceed:true
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   518
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   519
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   520
    "Created: / 27.10.1997 / 15:15:47 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   521
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   522
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   523
visibleMenuItemGroups
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   524
    |itemGroups visibleItemGroups nextItem|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   525
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   526
    itemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   527
    nextItem := 1.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   528
    groupSizes do:[:groupSize |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   529
        itemGroups addLast: (items copyFrom:nextItem to:nextItem + groupSize - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   530
        nextItem := nextItem + groupSize
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   531
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   532
    self hasHiddenItems ifFalse:[^ itemGroups].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   533
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   534
    "Remove the hidden items."
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   535
    visibleItemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   536
    itemGroups do:[:eachItemGroup |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   537
        |visibleItemGroup|
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   538
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   539
        visibleItemGroup := eachItemGroup reject:[:eachMenuItem | eachMenuItem hidden].
2129
e68ef88be0c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   540
        visibleItemGroup notEmpty ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   541
            visibleItemGroups addLast: visibleItemGroup
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   542
        ]
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   543
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   544
    ^ visibleItemGroups
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   545
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   546
    "Created: / 27.10.1997 / 15:07:50 / cg"
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   547
    "Modified: / 2.2.1998 / 13:25:52 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
1397
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1367
diff changeset
   550
!Menu methodsFor:'accessing-resource'!
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   551
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   552
findGuiResourcesIn:aResourceContainerOrApplication
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   553
    "setup a resource owner"
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   554
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   555
    receiver isNil ifTrue:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   556
        receiver := aResourceContainerOrApplication
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   557
    ].
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   558
    ^ self 
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   559
        findGuiResourcesIn:aResourceContainerOrApplication 
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   560
        rememberResourcesIn:(ValueHolder new)
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   561
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   562
    "Modified: / 26-10-2006 / 16:37:57 / cg"
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   563
!
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   564
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   565
findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:aValueHolderOrNil
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   566
    "setup a resource owner"
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   567
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   568
    |resolvedItems rcv|
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   569
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   570
    "/ cg: do not recursively change the receiver - it could be set for the top
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   571
    "/ menu via #receiver: by the application.
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   572
    "/ if the submenu's receiver is nil, the parentmenus receiver will be used, which is ok.
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   573
    "/ But if it was changed below, we would need a recursive setting in #receiver: as well.
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   574
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   575
"/    receiver isNil ifTrue:[
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   576
"/        receiver := aResourceContainerOrApplication
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   577
"/    ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   578
    items isEmptyOrNil ifTrue:[^ self].
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   579
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   580
    resolvedItems := OrderedCollection new.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   581
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   582
    items do:[:anItem |
2867
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   583
        anItem isMenuSlice ifTrue:[ 
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   584
            |resItems|
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   585
2059
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   586
            rcv := aResourceContainerOrApplication.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   587
            [rcv notNil and:[resItems isNil]] whileTrue:[
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   588
                resItems := anItem resolveSliceMenuItemsIn:rcv
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   589
                                   rememberResourcesIn:aValueHolderOrNil.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   590
                rcv := rcv perform:#masterApplication ifNotUnderstood:nil.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   591
            ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   592
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   593
            resItems notEmptyOrNil ifTrue:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   594
                resolvedItems addAll:resItems.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   595
            ]
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   596
        ] ifFalse:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   597
            anItem 
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   598
                findGuiResourcesIn:aResourceContainerOrApplication 
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   599
                rememberResourcesIn:aValueHolderOrNil.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   600
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   601
            resolvedItems add:anItem.
1534
292c277fcf6a findGuiResources... now sets the receiver, if not yet set
Claus Gittinger <cg@exept.de>
parents: 1532
diff changeset
   602
        ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   603
    ].
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   604
    items := resolvedItems.
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   605
2867
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   606
    "Modified: / 22-09-2010 / 13:34:38 / cg"
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   607
! !
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   608
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   609
!Menu methodsFor:'adding & removing'!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   610
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   611
addItem:aMenuItem
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   612
    "add a menuItem at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   613
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   614
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   615
    items isNil ifTrue:[
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   616
        items := OrderedCollection new
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   617
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   618
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   619
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   620
    items add:aMenuItem.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   621
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   622
    "Modified: / 4.8.1998 / 17:31:13 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   623
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   624
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   625
addItem:aMenuItem beforeIndex:anIndex
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   626
    "add a menuItem at some position;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   627
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   628
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   629
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   630
        items := OrderedCollection new
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   631
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   632
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   633
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   634
    items add:aMenuItem beforeIndex:anIndex.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   635
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   636
    "Modified: / 4.8.1998 / 17:31:39 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   637
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   638
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   639
addItem:aMenuItem value:aValue
3022
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   640
    aMenuItem itemValue:aValue.
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   641
    self addItem:aMenuItem.
3022
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   642
ce344185f4f4 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 2967
diff changeset
   643
    "Modified: / 09-09-2012 / 13:08:50 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   644
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   645
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   646
addItemGroup:aGroup
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   647
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   648
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   649
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   650
    groupSizes isNil ifTrue:[
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   651
        groupSizes := OrderedCollection with:items size.
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   652
    ].
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   653
    groupSizes add:aGroup size.
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   654
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   655
    aGroup do:[:item |
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   656
        self addItem:item
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   657
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   658
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   659
    "Created: / 27.10.1997 / 15:02:15 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   660
    "Modified: / 4.8.1998 / 17:32:06 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   661
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   662
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   663
addItemGroup:aGroup values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   664
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   665
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   666
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   667
    aGroup with:values do:[:item :value |
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   668
        item value:value
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   669
    ].
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   670
    self addItemGroup:aGroup
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   671
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   672
    "Modified: / 4.8.1998 / 17:32:18 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   673
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   674
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   675
addItemGroupLabels:labels values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   676
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   677
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   678
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   679
    |items|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   680
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   681
    items := labels with:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   682
                collect:[:label :value | 
3185
0d09b958253d class: Menu
Claus Gittinger <cg@exept.de>
parents: 3117
diff changeset
   683
                            MenuItem label:label itemValue:value
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   684
                        ].
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   685
    self addItemGroup:items
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   686
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   687
    "Created: / 27.10.1997 / 19:49:27 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   688
    "Modified: / 4.8.1998 / 17:35:22 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   689
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   690
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   691
addItemLabel:label value:value
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   692
    "add an item at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   693
     useful to build a menu programmatically (or, to add more items dynamically)"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   694
3185
0d09b958253d class: Menu
Claus Gittinger <cg@exept.de>
parents: 3117
diff changeset
   695
    self addItem:(MenuItem label:label itemValue:value)
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   696
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   697
    "Created: / 27.10.1997 / 19:47:12 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   698
    "Modified: / 4.8.1998 / 17:34:44 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   699
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   700
3226
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   701
addItems: collection
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   702
    "Add all items in given collection.
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   703
     Useful to build a menu programmatically (or, to add more items dynamically)"
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   704
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   705
    items isNil ifTrue:[
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   706
        items := OrderedCollection new
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   707
    ] ifFalse:[
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   708
        items := items asOrderedCollection
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   709
    ].
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   710
    items addAll: collection
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   711
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   712
    "Created: / 01-09-2013 / 16:43:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   713
!
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   714
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   715
addItemsFrom: anotherMenu
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   716
    "Add all items from another menu.
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   717
     Useful to build a menu programmatically (or, to add more items dynamically)"
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   718
3254
8c2680e496c9 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3245
diff changeset
   719
    self addItems: anotherMenu items ? #()
3226
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   720
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   721
    "Created: / 01-09-2013 / 16:44:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
3254
8c2680e496c9 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3245
diff changeset
   722
    "Modified: / 04-10-2013 / 19:28:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
3226
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   723
!
5cbe343a7611 class: Menu
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3222
diff changeset
   724
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   725
addSeparator
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   726
    "add a separating line item at the end;
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   727
     useful to build a menu programmatically (or, to add more items dynamically)"
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   728
2814
f75f27d92a5b changed: #addSeparator
Claus Gittinger <cg@exept.de>
parents: 2764
diff changeset
   729
    self addItem:(MenuItem separator).
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   730
!
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   731
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   732
removeItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   733
    "remove an item from the menu"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   734
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   735
    |idx|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   736
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   737
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   738
        idx := items identityIndexOf:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   739
        idx ~~ 0 ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   740
            items removeAtIndex:idx
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   741
        ]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   742
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   743
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   744
    "Created: / 13.9.1997 / 10:27:31 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   745
    "Modified: / 2.2.1998 / 13:26:49 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   746
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   747
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   748
removeItemAt:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   749
    "remove item at an index
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   750
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   751
    anIndex <= items size ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   752
        ^ items removeAtIndex:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   753
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   754
    ^ nil
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   755
! !
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   756
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
!Menu methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   759
asOldStylePopUpMenuFor:anApplicationOrNil
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   760
    "a temporary kludge - will vanish, when oldStyle MenuView and PopUpMenu are gone"
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   761
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   762
    |menuView itemsShown|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   763
2867
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   764
    itemsShown := items 
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   765
        select:[:each |
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   766
            |visibilityInItem|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   767
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   768
            visibilityInItem := each isVisible.
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   769
            visibilityInItem isNil ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   770
                true
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   771
            ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   772
                visibilityInItem isBoolean ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   773
                    visibilityInItem
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   774
                ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   775
                    visibilityInItem isSymbol ifTrue:[
2917
2ba0fee85a7f changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2916
diff changeset
   776
                        anApplicationOrNil isNil
2ba0fee85a7f changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2916
diff changeset
   777
                        or:[ (anApplicationOrNil perform:visibilityInItem) value ].
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   778
                    ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   779
                        visibilityInItem value
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   780
                    ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   781
                ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   782
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   783
        ].
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   784
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   785
    menuView := MenuView 
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   786
        labels:(itemsShown collect:[:each | each label])
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   787
        selectors:(itemsShown collect:[:each | each value])
2751
d0729d604864 changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2584
diff changeset
   788
        accelerators:(itemsShown collect:[:each | each shortcutKey])
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   789
        args:(itemsShown collect:[:each | each argument])
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   790
        receiver:receiver.
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   791
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   792
    itemsShown doWithIndex:[:each :idx |
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   793
        |enabledInItem enabled|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   794
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   795
        enabledInItem := each enabled.
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   796
        enabledInItem notNil ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   797
            enabledInItem isSymbol ifTrue:[
2917
2ba0fee85a7f changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2916
diff changeset
   798
                enabled := anApplicationOrNil isNil or:[ (anApplicationOrNil perform:enabledInItem) ].
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   799
            ] ifFalse:[
3028
29a0a22942fe changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 3022
diff changeset
   800
                enabled := enabledInItem
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   801
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   802
            enabled value ifFalse:[
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   803
                menuView disable:idx
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   804
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   805
        ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   806
    ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   807
3245
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   808
    menuView actions:(itemsShown
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   809
                        collect:[:each |
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   810
                            [ 
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   811
                                |actionOrSymbol|
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   812
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   813
                                actionOrSymbol := each itemValue.
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   814
                                actionOrSymbol isBlock ifTrue:[
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   815
                                    actionOrSymbol value
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   816
                                ] ifFalse:[
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   817
                                    receiver perform:actionOrSymbol 
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   818
                                ]
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   819
                            ]
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   820
                        ]
5dd413dddd1c class: Menu
Claus Gittinger <cg@exept.de>
parents: 3226
diff changeset
   821
                      ).
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   822
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   823
    ^ PopUpMenu forMenu:menuView
2867
b745ee0a04ac comment/format
Claus Gittinger <cg@exept.de>
parents: 2864
diff changeset
   824
2917
2ba0fee85a7f changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2916
diff changeset
   825
    "Modified: / 30-06-2011 / 10:35:57 / cg"
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   826
!
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   827
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
    |items groups values|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   833
    items := aLiteralEncodedArray at:2.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   834
2864
f90017f2da66 changed: #fromLiteralArrayEncoding:
Claus Gittinger <cg@exept.de>
parents: 2854
diff changeset
   835
    items notNil ifTrue:[
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   836
        items := items collect:[:item | item decodeAsLiteralArray].
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   837
    ].
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   838
    groups := aLiteralEncodedArray at:3 ifAbsent:nil.
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   839
    values := aLiteralEncodedArray at:4 ifAbsent:nil.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   840
    self menuItems:items menuItemGroups:groups values:values.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
    "extract from PD folder.st:
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   844
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   845
                        #rawLabel: 'left' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   846
                        #value: #left ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   847
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   848
                        #rawLabel: 'center' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   849
                        #value: #center ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   850
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   851
                        #rawLabel: 'right' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   852
                        #value: #right ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   853
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   854
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   855
             nil 
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
       ) decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
    "
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   858
    "
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   859
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   860
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   861
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   862
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   863
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   864
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   865
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   866
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   867
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   868
            #(#straightenUp #inspect #halt ) 
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   869
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   870
    "
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   871
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   872
    "extract from iconicBrowser.st:
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   873
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   874
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   875
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   876
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   877
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   878
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   879
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   880
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   881
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   882
             #(1 2 3 )
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   883
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   884
    "
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   886
    "extract from refactory213.st:
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   887
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   888
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   889
                    #label: 'File List' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   890
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   891
                #(#MenuItem #label: 'File Editor...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   892
                    #accessCharacterPosition: 6 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   893
                #(#MenuItem #label: 'Refactoring Tool...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   894
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   895
                #(#MenuItem #label: 'Workspace' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   896
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   897
                #(#MenuItem #label: 'New Canvas' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   898
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   899
                #(#MenuItem #label: 'Palette' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   900
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   901
                #(#MenuItem #label: 'Canvas Tool' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   902
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   903
                #(#MenuItem #label: 'Image Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   904
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   905
                #(#MenuItem #label: 'Menu Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   906
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   907
                #(#MenuItem #label: 'Advanced' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   908
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   909
                #(#MenuItem #label: 'DLL and C Connect' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   910
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   911
                #(#MenuItem #label: 'System Transcript' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   912
                    #accessCharacterPosition: 8 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   913
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   914
              #(4 5 2 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   915
              #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   916
        ) decodeAsLiteralArray startUp
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   917
    "
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   918
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   919
    "submenus:
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   920
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   921
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   922
                        #label: 'Foo' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   923
                        #submenu: #(#Menu #(
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   924
                                            #(#MenuItem #label: 'foo 1')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   925
                                            #(#MenuItem #label: 'foo 2')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   926
                                          )
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   927
                                          nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   928
                                          #(11 22)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   929
                                   )     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   930
                 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   931
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   932
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   933
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   934
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   935
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   936
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   937
             #(1 2 3 )
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   938
       ) decodeAsLiteralArray startUp  
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   939
    "
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   940
2864
f90017f2da66 changed: #fromLiteralArrayEncoding:
Claus Gittinger <cg@exept.de>
parents: 2854
diff changeset
   941
    "Modified: / 08-08-2010 / 14:43:03 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   942
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   943
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   944
literalArrayEncoding
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   945
    "return myself encoded as a literal array"
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   946
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   947
    |coll array size|
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   948
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   949
    coll := OrderedCollection new.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   950
    coll add:#Menu.
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   951
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   952
    (size := items size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   953
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   954
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   955
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   956
        items keysAndValuesDo:[:anIndex :anItem|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   957
            array at:anIndex put:(anItem literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   958
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   959
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   960
    coll add:array.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   961
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   962
    (size := groupSizes size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   963
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   964
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   965
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   966
        groupSizes keysAndValuesDo:[:anIndex :aSize|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   967
            array at:anIndex put:(aSize literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   968
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   969
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   970
    coll add:array.
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   971
    coll add:nil.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   972
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   973
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   974
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   975
!Menu methodsFor:'enumerating'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   976
2494
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   977
allItemsDetect:aOneArgBlock ifNone:exceptionalValue
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   978
    "find an element amongst each item and submenu items"
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   979
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   980
    self itemsDo:[:anItem|
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   981
        |sub subItem|
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   982
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   983
        (aOneArgBlock value:anItem) ifTrue:[^ anItem].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   984
        (sub := anItem submenu) notNil ifTrue:[
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   985
            subItem := sub allItemsDetect:aOneArgBlock ifNone:nil.
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   986
            subItem notNil ifTrue:[^ subItem].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   987
        ]
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   988
    ].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   989
    ^ exceptionalValue value
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   990
!
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   991
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   992
allItemsDo:aOneArgBlock
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   993
    "evaluate block on each item and submenu items
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   994
    "
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   995
    self itemsDo:[:anItem|
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   996
        |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   997
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   998
        aOneArgBlock value:anItem.
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   999
        (sub := anItem submenu) notNil ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1000
            sub allItemsDo:aOneArgBlock
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1001
        ]
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
  1002
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1003
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1004
    "Modified: / 19.6.1998 / 00:34:53 / cg"
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
  1005
!
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
  1006
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1007
detectItem:aBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1008
    "evaluate the argument, aBlock for each item in the menu until the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1009
     block returns true; in this case return the item which caused the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1010
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1011
     If none of the evaluations returns true, return the result of the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1012
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1013
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1014
    ^ self detectItem:aBlock ifNone:[self errorNotFound]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1015
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1016
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1017
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1018
detectItem:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1019
    "evaluate the argument, aBlock for each item in the menu until the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1020
     block returns true; in this case return the item which caused the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1021
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1022
     If none of the evaluations returns true, return the result of the
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1023
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1024
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1025
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1026
        ^ items detect:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1027
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1028
    ^ exceptionBlock value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1029
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
  1030
589
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1031
itemsDo:aOneArgBlock
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1032
    "evaluate the block for each item in the current menu
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1033
    "
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1034
    items notNil ifTrue:[items do:aOneArgBlock]
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1035
!
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
  1036
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1037
menuAndSubmenusDetectItem:aOneArgBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1038
    "evaluate the block for each item in the current menu and all
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1039
     submenus. In case that the block returns a non nil argument,
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1040
     the item will be returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1041
    "
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1042
    |item|
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1043
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1044
    items notNil ifTrue:[
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1045
        items do:[:anItem|
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1046
            |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1047
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1048
            (aOneArgBlock value:anItem) ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1049
                ^ anItem
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1050
            ].
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1051
            (sub := anItem submenu) notNil ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1052
                item := sub menuAndSubmenusDetectItem:aOneArgBlock.
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1053
                item notNil ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1054
                    ^ item
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1055
                ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1056
            ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1057
        ]
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1058
    ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1059
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1060
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
  1061
    "Modified: / 19.6.1998 / 00:35:00 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1062
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1063
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1064
!Menu methodsFor:'kludged fixes'!
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1065
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1066
destroy
1599
85108dff13a9 comment
Claus Gittinger <cg@exept.de>
parents: 1534
diff changeset
  1067
    "dummy to allow a menu to be used where a MenuView used to be"
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1068
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1069
    "Created: 28.7.1997 / 10:16:52 / cg"
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1070
! !
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
  1071
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1072
!Menu methodsFor:'menu items'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1073
2404
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1074
removeAllAccelerators
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1075
    self allItemsDo:[:eachItem |
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1076
        eachItem shortcutKey:nil.
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1077
    ].
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1078
!
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
  1079
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1080
someMenuItemLabeled:aLabel
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1081
    "get the menu item with that label; in case that the label
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1082
     is not found, nil is returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1083
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1084
    ^ self someMenuItemLabeled:aLabel ifNone:nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1085
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1086
    "Created: / 14.11.1997 / 20:55:17 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1087
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1088
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1089
someMenuItemLabeled:aLabel ifNone:exceptionBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1090
    "get the menu item labeled aLabel; in case that the value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1091
     is not found, the given exceptionBlock is executed and its value returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1092
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1093
    |item|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1094
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1095
    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1096
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1097
    item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1098
	^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1099
    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1100
    ^ exceptionBlock value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1101
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1102
    "Created: / 14.11.1997 / 20:56:13 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1103
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1104
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1105
someMenuItemWithValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1106
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1107
     is not found nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1108
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1109
    ^ self someMenuItemWithValue:aValue ifNone:nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1110
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1111
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1112
someMenuItemWithValue:aValue ifNone:exceptionBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1113
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1114
     is not found, the given exceptionBlock is executed and returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1115
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1116
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1117
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1118
    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1119
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1120
    item notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1121
	^ item
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1122
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1123
  ^ exceptionBlock value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1124
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1125
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1126
!Menu methodsFor:'queries'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1127
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1128
hasHiddenItems
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1129
    "test whether any item is hidden"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1130
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1131
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1132
	anItem isHidden ifTrue:[^ true]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1133
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1134
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1135
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1136
    "Modified: / 27.10.1997 / 15:12:44 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1137
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1138
2584
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1139
hasItems
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1140
    "test whether there are any menu-items"
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1141
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1142
    ^ items notEmptyOrNil
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1143
!
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1144
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1145
hasSubMenuAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1146
    "test whether the menu item at the given index has a submenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1147
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1148
    ^ (self menuItemAt:anIndex) hasSubmenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1149
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1150
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1151
!Menu methodsFor:'startup'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1152
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1153
show
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1154
    "realize the menu at its last position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1155
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1156
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1157
    ^ (MenuPanel menu:self) show ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1158
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1159
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1160
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1161
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1162
showAt:aPoint
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1163
    "realize the menu at aPoint; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1164
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1165
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1166
    ^ self showAt:aPoint resizing:true
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1167
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1168
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1169
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1170
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1171
showAt:aPoint resizing:aBoolean
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1172
    "realize the menu at aPoint; returns the value associated with the
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1173
     selected item, 0 if none was selected"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1174
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1175
    ^ ((MenuPanel menu:self) showAt:aPoint resizing:aBoolean) ? 0
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1176
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1177
    "Modified: / 8.7.1998 / 19:57:55 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1178
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1179
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1180
showAtPointer
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1181
    "realize the menu at the current pointer position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1182
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1183
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1184
    ^ self startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1185
!
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1186
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1187
showCenteredIn:aView
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1188
    "realize the menu visible at the aView center; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1189
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1190
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1191
    ^ ((MenuPanel menu:self) showCenteredIn:aView) ? 0
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1192
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1193
    "Modified: / 8.7.1998 / 19:58:05 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1194
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1195
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1196
startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1197
    "display the menu as a popUp; returns the value associated with the
2039
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1198
     selected item, nil if none was selected.
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1199
     (should we return 0 form ST-80 compatibility ?)"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1200
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1201
    ^ (MenuPanel menu:self) startUp "/ ? 0
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1202
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1203
"   
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1204
        |m|
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1205
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1206
        m := #(#Menu #(
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1207
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1208
                                #rawLabel: 'left' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1209
                                #value: #left ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1210
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1211
                                #rawLabel: 'center' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1212
                                #value: #center ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1213
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1214
                                #rawLabel: 'right' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1215
                                #value: #right ) ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1216
                 #(2) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1217
                nil 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1218
        ) decodeAsLiteralArray.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1219
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1220
      Transcript showCR:(m startUp)        
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1221
"
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1222
!
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1223
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1224
startUpAt:aPoint
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1225
    "display the menu as a popUp at aPoint; returns the value associated with the
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1226
     selected item, 0 if none was selected"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1227
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1228
    ^ ((MenuPanel menu:self) startUpAt:aPoint) ? 0
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1229
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1230
"   
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1231
        |m|
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1232
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1233
        m := #(#Menu #(
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1234
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1235
                                #rawLabel: 'left' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1236
                                #value: #left ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1237
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1238
                                #rawLabel: 'center' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1239
                                #value: #center ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1240
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1241
                                #rawLabel: 'right' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1242
                                #value: #right ) ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1243
                 #(2) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1244
                nil 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1245
        ) decodeAsLiteralArray.
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1246
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1247
      Transcript showCR:(m startUpAt:100@100)        
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1248
"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1249
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1250
    "Created: / 21.5.1998 / 14:15:21 / cg"
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1251
    "Modified: / 21.5.1998 / 14:17:46 / cg"
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1252
!
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1253
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1254
startUpFor:originatingWidget
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1255
    "display the menu as a popUp; returns the value associated with the
2039
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1256
     selected item, nil if none was selected.
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1257
     (should we return 0 for ST-80 compatibility ?)"
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1258
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1259
    ^ (MenuPanel menu:self) startUpFor:originatingWidget "/ ? 0
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1260
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1261
"   
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1262
        |m|
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1263
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1264
        m := #(#Menu #(
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1265
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1266
                                #rawLabel: 'left' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1267
                                #value: #left ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1268
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1269
                                #rawLabel: 'center' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1270
                                #value: #center ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1271
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1272
                                #rawLabel: 'right' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1273
                                #value: #right ) ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1274
                 #(2) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1275
                nil 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1276
        ) decodeAsLiteralArray.
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1277
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1278
      Transcript showCR:(m startUp)        
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1279
"
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1280
!
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1281
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1282
startUpOrNil
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1283
    "display the menu as a popUp; returns the value associated with the
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1284
     selected item, nil if none was selected"
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1285
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
  1286
    ^ (MenuPanel menu:self) startUpOrNil
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1287
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1288
2967
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1289
!Menu methodsFor:'utilities'!
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1290
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1291
replaceArgument: oldValue with: newValue
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1292
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1293
    "Recusively Replace argument in menu items where
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1294
     current argument is equal to oldValue by newValue"
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1295
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1296
    self itemsDo:[:item|
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1297
        item replaceArgument: oldValue with: newValue
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1298
    ]
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1299
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1300
    "Created: / 12-10-2011 / 20:11:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1301
! !
c50ab5fa6cf0 Added #replaceArgument:with:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2952
diff changeset
  1302
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1303
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1304
2764
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
  1305
version_CVS
3340
96d5a7df1639 class: Menu
Claus Gittinger <cg@exept.de>
parents: 3254
diff changeset
  1306
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.92 2014-05-23 07:19:21 cg Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1307
! !
3117
3c7f6b69b2c5 Changed usage of deprecated #copyWithoutLast: to #copyButLast:
Stefan Vogel <sv@exept.de>
parents: 3028
diff changeset
  1308