Menu.st
author Claus Gittinger <cg@exept.de>
Fri, 04 Dec 2009 14:38:27 +0100
changeset 2814 f75f27d92a5b
parent 2764 c83f22018324
child 2854 d37c539b59ad
permissions -rw-r--r--
changed: #addSeparator
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
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
Object 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
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    86
        mi := MenuItem labeled:(arrayOfString at:i) asString.
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
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
   186
    self addItem:(MenuItem label:label value:[target perform:selector]).
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).
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   207
        item value:(selections at:idx).
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
    ].
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   214
! !
6a40c04cda8c squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
   215
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
!Menu methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   218
atNameKey:aNameKey
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   219
    "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
   220
     Searches in allItems (i.e. also in subMenus)"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   221
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   222
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   223
	anItem nameKey == aNameKey ifTrue:[^ anItem]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   224
    ].
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   225
    ^ nil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   226
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   227
    "Modified: / 27.10.1997 / 15:12:00 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   228
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   229
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   230
groupSizes
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   231
    ^ groupSizes
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   232
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   233
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   234
groupSizes:something
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   235
    groupSizes := something.
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   236
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   237
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   238
items
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   239
    ^ items
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   240
!
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   241
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   242
labelAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   243
    "gets the label of the menu item at the given index or nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   244
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   245
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   246
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   247
    (item := self menuItemAt:anIndex) notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   248
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   249
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   250
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   251
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   252
    "Modified: / 2.2.1998 / 13:28:32 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   253
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   254
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   255
labelAtValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   256
    "gets the label of the menu item assigned to value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   257
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   258
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   259
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   260
    item := self menuAndSubmenusDetectItem:[:anItem | anItem value == aValue ].
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   261
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   262
    item notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   263
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   264
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   265
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   266
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   267
    "Modified: / 2.2.1998 / 13:28:28 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   268
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   269
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
labels
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
    "return a collection of labels from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   273
    items isNil ifTrue:[^ #()].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
    ^ items collect:[:anItem | anItem label]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   276
    "Created: / 25.2.1997 / 19:47:53 / cg"
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   277
    "Modified: / 19.6.1998 / 02:36:22 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   280
lastItem
2584
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   281
    "returns the last item or nil, if there are none"
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   282
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   283
    ^ items isEmptyOrNil 
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   284
        ifTrue:[nil]
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
   285
        ifFalse:[items last]
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   286
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   287
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   288
lines
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   289
    "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
   290
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   291
    |lines groupSz|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   292
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   293
    (groupSz := groupSizes size) <= 1 ifTrue: [^ Array new].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   294
    lines := Array new:(groupSz - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   295
    lines at:1 put:groupSizes first.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   296
    2 to:(groupSz-1) do:[:i |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   297
        lines at:i put:(lines at:(i - 1)) + (groupSizes at:i)
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   298
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   299
    ^ lines
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   300
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   301
    "Modified: / 2.2.1998 / 13:28:19 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   302
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   303
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   304
menuItemAt:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   305
    "gets the menu item at the given index. When the index is out of bounds
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   306
     nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   307
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   308
    (index > 0 and:[index <= items size]) ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   309
	^ items at:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   310
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   311
  ^ nil
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   312
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   313
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   314
menuItemLabeled:anItemLabel
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   315
    "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
   316
     Searches all items (i.e. also submenu items)"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   317
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   318
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   319
		|l|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   320
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   321
		((l := anItem label) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   322
		    ^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   323
		].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   324
		(l includes:$&) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   325
		    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   326
			^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   327
		    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   328
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   329
	     ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   330
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   331
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   332
    "Created: / 13.9.1997 / 10:25:16 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   333
    "Modified: / 27.10.1997 / 15:23:33 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   334
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   335
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   336
menuItemWithValue:aValue
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   337
    "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
   338
     Searches all items (i.e. also submenu items)"
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   339
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   340
    self allItemsDo:[:anItem|
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   341
                |l|
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   342
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   343
                (anItem value == aValue) ifTrue:[
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   344
                    ^ anItem
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   345
                ].
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   346
             ].
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   347
    ^ nil
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   348
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   349
    "Created: / 13.9.1997 / 10:25:16 / cg"
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   350
    "Modified: / 27.10.1997 / 15:23:33 / cg"
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   351
!
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
   352
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   353
menuItems
1327
b0b482a84570 menuItems always returns a collection (never nil)
Claus Gittinger <cg@exept.de>
parents: 1308
diff changeset
   354
    ^ items ? #()
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   355
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   356
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   357
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
   358
    |n|
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   359
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   360
    items := groupSizes := nil.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   361
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   362
    aCollectionOfMenuItems size == 0 ifTrue:[ ^ self ].
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   363
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
    items := aCollectionOfMenuItems.
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   365
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   366
    sizes size > 0 ifTrue:[
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   367
        groupSizes := sizes.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   368
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   369
        n := sizes inject:0 into:[:sumSoFar :this | sumSoFar + this].
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   370
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   371
        n = items size ifTrue:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   372
            groupSizes := sizes copyWithoutLast:1
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   373
        ]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   374
    ].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   376
    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
   377
        items with:values do:[:anItem :aValue |anItem value:aValue]
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   378
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   379
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   380
    "Modified: / 19.4.1998 / 11:47:34 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
1116
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   383
menuPerformer:something
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   384
    "set the receiver of the menu messages"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   385
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   386
    receiver := something.
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   387
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   388
    "Modified: / 2.2.1998 / 13:26:29 / cg"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   389
!
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   390
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   391
numberOfItems
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   392
    "return the number of items in this menu"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   393
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   394
    ^ items size
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   395
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   396
    "Created: / 6.3.1997 / 15:15:53 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   397
    "Modified: / 2.2.1998 / 13:26:40 / cg"
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   398
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   399
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   400
receiver
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   401
    "return the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   402
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   403
    ^ receiver
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   404
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   405
    "Modified: / 2.2.1998 / 13:26:20 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   406
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   407
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   408
receiver:something
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   409
    "set the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   410
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   411
    receiver := something.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   412
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   413
    "Modified: / 2.2.1998 / 13:26:29 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   414
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   415
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
valueAt:index
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
    ^ (items at:index) value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
    "Created: 25.2.1997 / 19:49:41 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   424
valueAt:anIndex put:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   425
    "put value an an index"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   426
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   427
    (items at:anIndex) value:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   428
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   429
    "Created: 6.3.1997 / 15:15:48 / cg"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   430
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   431
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
values
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
    ^ items collect:[:anItem | anItem value]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
    "Created: 25.2.1997 / 19:49:29 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   438
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   439
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   440
values:aCollectionOfValues
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   441
    "return a collection of values from my items"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   442
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   443
    |s|
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   444
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   445
    s := aCollectionOfValues readStream.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   446
    self itemsDo:[:item |
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   447
        |val|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   448
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   449
        val := s next.
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   450
        item value:val
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   451
    ].
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   452
    s atEnd ifFalse:[
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   453
        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
   454
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   455
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   456
    "Created: / 27.10.1997 / 15:15:47 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   457
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   458
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   459
visibleMenuItemGroups
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   460
    |itemGroups visibleItemGroups nextItem|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   461
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   462
    itemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   463
    nextItem := 1.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   464
    groupSizes do:[:groupSize |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   465
        itemGroups addLast: (items copyFrom:nextItem to:nextItem + groupSize - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   466
        nextItem := nextItem + groupSize
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   467
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   468
    self hasHiddenItems ifFalse:[^ itemGroups].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   469
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   470
    "Remove the hidden items."
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   471
    visibleItemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   472
    itemGroups do:[:eachItemGroup |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   473
        |visibleItemGroup|
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   474
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   475
        visibleItemGroup := eachItemGroup reject:[:eachMenuItem | eachMenuItem hidden].
2129
e68ef88be0c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2126
diff changeset
   476
        visibleItemGroup notEmpty ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   477
            visibleItemGroups addLast: visibleItemGroup
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   478
        ]
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   479
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   480
    ^ visibleItemGroups
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   481
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   482
    "Created: / 27.10.1997 / 15:07:50 / cg"
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   483
    "Modified: / 2.2.1998 / 13:25:52 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
1397
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1367
diff changeset
   486
!Menu methodsFor:'accessing-resource'!
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   487
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   488
findGuiResourcesIn:aResourceContainerOrApplication
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   489
    "setup a resource owner"
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   490
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   491
    receiver isNil ifTrue:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   492
        receiver := aResourceContainerOrApplication
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   493
    ].
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   494
    ^ self 
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   495
        findGuiResourcesIn:aResourceContainerOrApplication 
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   496
        rememberResourcesIn:(ValueHolder new)
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   497
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   498
    "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
   499
!
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   500
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   501
findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:aValueHolderOrNil
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   502
    "setup a resource owner"
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   503
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   504
    |resolvedItems rcv|
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   505
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   506
    "/ 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
   507
    "/ menu via #receiver: by the application.
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   508
    "/ 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
   509
    "/ 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
   510
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   511
"/    receiver isNil ifTrue:[
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   512
"/        receiver := aResourceContainerOrApplication
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   513
"/    ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   514
    items isEmptyOrNil ifTrue:[^ self].
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   515
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   516
    resolvedItems := OrderedCollection new.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   517
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   518
    items do:[:anItem |
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   519
        anItem isMenuSlice ifTrue:[ |resItems|
2059
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   520
            rcv := aResourceContainerOrApplication.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   521
            [rcv notNil and:[resItems isNil]] whileTrue:[
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   522
                resItems := anItem resolveSliceMenuItemsIn:rcv
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   523
                                   rememberResourcesIn:aValueHolderOrNil.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   524
                rcv := rcv perform:#masterApplication ifNotUnderstood:nil.
36e4aa247402 fixed menu-slice resolving (search in masterApplication too)
Claus Gittinger <cg@exept.de>
parents: 2039
diff changeset
   525
            ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   526
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   527
            resItems notEmptyOrNil ifTrue:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   528
                resolvedItems addAll:resItems.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   529
            ]
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   530
        ] ifFalse:[
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   531
            anItem 
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   532
                findGuiResourcesIn:aResourceContainerOrApplication 
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   533
                rememberResourcesIn:aValueHolderOrNil.
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   534
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   535
            resolvedItems add:anItem.
1534
292c277fcf6a findGuiResources... now sets the receiver, if not yet set
Claus Gittinger <cg@exept.de>
parents: 1532
diff changeset
   536
        ].
1986
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   537
    ].
f819e439d917 *** empty log message ***
ca
parents: 1782
diff changeset
   538
    items := resolvedItems.
2269
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   539
7fae2df3ba48 resolveGUIResources no longer sets the receiver recursively
Claus Gittinger <cg@exept.de>
parents: 2129
diff changeset
   540
    "Modified: / 26-10-2006 / 16:45:14 / cg"
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   541
! !
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   542
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   543
!Menu methodsFor:'adding & removing'!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   544
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   545
addItem:aMenuItem
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   546
    "add a menuItem at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   547
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   548
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   549
    items isNil ifTrue:[
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   550
        items := OrderedCollection new
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   551
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   552
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   553
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   554
    items add:aMenuItem.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   555
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   556
    "Modified: / 4.8.1998 / 17:31:13 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   557
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   558
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   559
addItem:aMenuItem beforeIndex:anIndex
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   560
    "add a menuItem at some position;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   561
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   562
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   563
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   564
        items := OrderedCollection new
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   565
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   566
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   567
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   568
    items add:aMenuItem beforeIndex:anIndex.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   569
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   570
    "Modified: / 4.8.1998 / 17:31:39 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   571
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   572
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   573
addItem:aMenuItem value:aValue
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   574
    aMenuItem value:aValue.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   575
    self addItem:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   576
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   577
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   578
addItemGroup:aGroup
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   579
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   580
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   581
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   582
    groupSizes isNil ifTrue:[
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   583
        groupSizes := OrderedCollection with:items size.
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   584
    ].
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   585
    groupSizes add:aGroup size.
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   586
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   587
    aGroup do:[:item |
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   588
        self addItem:item
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   589
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   590
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   591
    "Created: / 27.10.1997 / 15:02:15 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   592
    "Modified: / 4.8.1998 / 17:32:06 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   593
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   594
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   595
addItemGroup:aGroup values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   596
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   597
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   598
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   599
    aGroup with:values do:[:item :value |
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   600
        item value:value
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   601
    ].
1758
b55ccdd15885 itemGroup fix
Claus Gittinger <cg@exept.de>
parents: 1652
diff changeset
   602
    self addItemGroup:aGroup
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   603
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   604
    "Modified: / 4.8.1998 / 17:32:18 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   605
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   606
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   607
addItemGroupLabels:labels values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   608
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   609
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   610
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   611
    |items|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   612
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   613
    items := labels with:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   614
                collect:[:label :value | 
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   615
                            MenuItem label:label value:value
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   616
                        ].
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   617
    self addItemGroup:items
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   618
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   619
    "Created: / 27.10.1997 / 19:49:27 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   620
    "Modified: / 4.8.1998 / 17:35:22 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   621
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   622
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   623
addItemLabel:label value:value
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   624
    "add an item at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   625
     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
   626
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   627
    self addItem:(MenuItem label:label value:value)
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   628
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   629
    "Created: / 27.10.1997 / 19:47:12 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   630
    "Modified: / 4.8.1998 / 17:34:44 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   631
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   632
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   633
addSeparator
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   634
    "add a separating line item at the end;
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   635
     useful to build a menu programmatically (or, to add more items dynamically)"
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   636
2814
f75f27d92a5b changed: #addSeparator
Claus Gittinger <cg@exept.de>
parents: 2764
diff changeset
   637
    self addItem:(MenuItem separator).
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   638
!
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   639
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   640
removeItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   641
    "remove an item from the menu"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   642
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   643
    |idx|
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
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   646
        idx := items identityIndexOf:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   647
        idx ~~ 0 ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   648
            items removeAtIndex:idx
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   649
        ]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   650
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   651
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   652
    "Created: / 13.9.1997 / 10:27:31 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   653
    "Modified: / 2.2.1998 / 13:26:49 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   654
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   655
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   656
removeItemAt:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   657
    "remove item at an index
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
    anIndex <= items size ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   660
        ^ items removeAtIndex:anIndex
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
    ^ nil
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   663
! !
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   664
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
!Menu methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   667
asOldStylePopUpMenuFor:anApplicationOrNil
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   668
    "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
   669
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   670
    |menuView itemsShown|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   671
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   672
    itemsShown := items select:[:each |
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   673
            |visibilityInItem|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   674
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   675
            visibilityInItem := each isVisible.
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   676
            visibilityInItem isNil ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   677
                true
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   678
            ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   679
                visibilityInItem isBoolean ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   680
                    visibilityInItem
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   681
                ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   682
                    visibilityInItem isSymbol ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   683
                        (anApplicationOrNil perform:visibilityInItem) value.
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   684
                    ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   685
                        visibilityInItem value
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   686
                    ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   687
                ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   688
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   689
        ].
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   690
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   691
    menuView := MenuView 
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   692
        labels:(itemsShown collect:[:each | each label])
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   693
        selectors:(itemsShown collect:[:each | each value])
2751
d0729d604864 changed: #asOldStylePopUpMenuFor:
Claus Gittinger <cg@exept.de>
parents: 2584
diff changeset
   694
        accelerators:(itemsShown collect:[:each | each shortcutKey])
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   695
        args:(itemsShown collect:[:each | each argument])
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   696
        receiver:receiver.
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   697
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   698
    itemsShown doWithIndex:[:each :idx |
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   699
        |enabledInItem enabled|
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   700
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   701
        enabledInItem := each enabled.
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   702
        enabledInItem notNil ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   703
            enabledInItem isSymbol ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   704
                enabled := (anApplicationOrNil perform:enabledInItem).
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   705
            ] ifFalse:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   706
                enabledInItem isBoolean ifTrue:[
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   707
                    enabled := enabledInItem
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   708
                ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   709
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   710
            enabled value ifFalse:[
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   711
                menuView disable:idx
2081
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   712
            ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   713
        ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   714
    ].
52ba70a79ce9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2080
diff changeset
   715
2092
Claus Gittinger <cg@exept.de>
parents: 2081
diff changeset
   716
    menuView actions:(itemsShown collect:[:each | [ receiver perform:each value ]]).
2080
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   717
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   718
    ^ PopUpMenu forMenu:menuView
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   719
!
4fe491fe114c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2059
diff changeset
   720
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
    |items groups values|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
1620
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   726
    items := aLiteralEncodedArray at:2.
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   727
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   728
    items ifNotNil:[
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   729
        items := items collect:[:item | item decodeAsLiteralArray].
bf72298c42bc bug fixes; handle unspecified items in literalArrayEncoding
ca
parents: 1599
diff changeset
   730
    ].
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   731
    groups := aLiteralEncodedArray at:3 ifAbsent:nil.
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   732
    values := aLiteralEncodedArray at:4 ifAbsent:nil.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   733
    self menuItems:items menuItemGroups:groups values:values.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
    "extract from PD folder.st:
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   737
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   738
                        #rawLabel: 'left' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   739
                        #value: #left ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   740
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   741
                        #rawLabel: 'center' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   742
                        #value: #center ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   743
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   744
                        #rawLabel: 'right' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   745
                        #value: #right ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   746
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   747
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   748
             nil 
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
       ) decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
    "
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   751
    "
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   752
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   753
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   754
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   755
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   756
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   757
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   758
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   759
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   760
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   761
            #(#straightenUp #inspect #halt ) 
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   762
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   763
    "
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   764
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   765
    "extract from iconicBrowser.st:
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   766
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   767
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   768
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   769
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   770
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   771
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   772
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   773
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   774
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   775
             #(1 2 3 )
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   776
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   777
    "
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   779
    "extract from refactory213.st:
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   780
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   781
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   782
                    #label: 'File List' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   783
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   784
                #(#MenuItem #label: 'File Editor...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   785
                    #accessCharacterPosition: 6 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   786
                #(#MenuItem #label: 'Refactoring Tool...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   787
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   788
                #(#MenuItem #label: 'Workspace' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   789
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   790
                #(#MenuItem #label: 'New Canvas' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   791
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   792
                #(#MenuItem #label: 'Palette' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   793
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   794
                #(#MenuItem #label: 'Canvas Tool' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   795
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   796
                #(#MenuItem #label: 'Image Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   797
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   798
                #(#MenuItem #label: 'Menu Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   799
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   800
                #(#MenuItem #label: 'Advanced' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   801
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   802
                #(#MenuItem #label: 'DLL and C Connect' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   803
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   804
                #(#MenuItem #label: 'System Transcript' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   805
                    #accessCharacterPosition: 8 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   806
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   807
              #(4 5 2 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   808
              #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   809
        ) decodeAsLiteralArray startUp
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   810
    "
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   811
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   812
    "submenus:
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   813
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   814
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   815
                        #label: 'Foo' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   816
                        #submenu: #(#Menu #(
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   817
                                            #(#MenuItem #label: 'foo 1')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   818
                                            #(#MenuItem #label: 'foo 2')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   819
                                          )
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   820
                                          nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   821
                                          #(11 22)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   822
                                   )     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   823
                 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   824
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   825
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   826
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   827
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   828
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   829
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   830
             #(1 2 3 )
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   831
       ) decodeAsLiteralArray startUp  
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   832
    "
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   833
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   834
    "Modified: 20.6.1997 / 10:45:51 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   835
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   836
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   837
literalArrayEncoding
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   838
    "return myself encoded as a literal array"
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   839
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   840
    |coll array size|
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   841
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   842
    coll := OrderedCollection new.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   843
    coll add:#Menu.
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   844
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   845
    (size := items size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   846
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   847
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   848
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   849
        items keysAndValuesDo:[:anIndex :anItem|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   850
            array at:anIndex put:(anItem literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   851
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   852
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   853
    coll add:array.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   854
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   855
    (size := groupSizes size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   856
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   857
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   858
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   859
        groupSizes keysAndValuesDo:[:anIndex :aSize|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   860
            array at:anIndex put:(aSize literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   861
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   862
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   863
    coll add:array.
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   864
    coll add:nil.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   865
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   868
!Menu methodsFor:'enumerating'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   869
2494
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   870
allItemsDetect:aOneArgBlock ifNone:exceptionalValue
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   871
    "find an element amongst each item and submenu items"
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   872
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   873
    self itemsDo:[:anItem|
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   874
        |sub subItem|
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   875
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   876
        (aOneArgBlock value:anItem) ifTrue:[^ anItem].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   877
        (sub := anItem submenu) notNil ifTrue:[
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   878
            subItem := sub allItemsDetect:aOneArgBlock ifNone:nil.
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   879
            subItem notNil ifTrue:[^ subItem].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   880
        ]
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   881
    ].
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   882
    ^ exceptionalValue value
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   883
!
994b030ae562 new enumerator: allItemsDetect:ifNone:
Claus Gittinger <cg@exept.de>
parents: 2433
diff changeset
   884
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   885
allItemsDo:aOneArgBlock
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   886
    "evaluate block on each item and submenu items
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   887
    "
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   888
    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
   889
        |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   890
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   891
        aOneArgBlock value:anItem.
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   892
        (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
   893
            sub allItemsDo:aOneArgBlock
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   894
        ]
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   895
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   896
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   897
    "Modified: / 19.6.1998 / 00:34:53 / cg"
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   898
!
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   899
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   900
detectItem:aBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   901
    "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
   902
     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
   903
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   904
     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
   905
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   906
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   907
    ^ self detectItem:aBlock ifNone:[self errorNotFound]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   908
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   909
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   910
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   911
detectItem:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   912
    "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
   913
     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
   914
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   915
     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
   916
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   917
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   918
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   919
        ^ items detect:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   920
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   921
    ^ exceptionBlock value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   922
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   923
589
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   924
itemsDo:aOneArgBlock
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   925
    "evaluate the block for each item in the current menu
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   926
    "
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   927
    items notNil ifTrue:[items do:aOneArgBlock]
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   928
!
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   929
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   930
menuAndSubmenusDetectItem:aOneArgBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   931
    "evaluate the block for each item in the current menu and all
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   932
     submenus. In case that the block returns a non nil argument,
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   933
     the item will be returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   934
    "
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   935
    |item|
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   936
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   937
    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
   938
        items do:[:anItem|
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   939
            |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   940
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   941
            (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
   942
                ^ anItem
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   943
            ].
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   944
            (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
   945
                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
   946
                item notNil ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   947
                    ^ item
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   948
                ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   949
            ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   950
        ]
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   951
    ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   952
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   953
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   954
    "Modified: / 19.6.1998 / 00:35:00 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   955
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   956
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   957
!Menu methodsFor:'kludged fixes'!
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   958
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   959
destroy
1599
85108dff13a9 comment
Claus Gittinger <cg@exept.de>
parents: 1534
diff changeset
   960
    "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
   961
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   962
    "Created: 28.7.1997 / 10:16:52 / cg"
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   963
! !
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   964
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   965
!Menu methodsFor:'menu items'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   966
2404
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   967
removeAllAccelerators
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   968
    self allItemsDo:[:eachItem |
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   969
        eachItem shortcutKey:nil.
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   970
    ].
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   971
!
8cbc5d26f26e +removeAllAccelerators
Claus Gittinger <cg@exept.de>
parents: 2269
diff changeset
   972
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   973
someMenuItemLabeled:aLabel
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   974
    "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
   975
     is not found, nil is returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   976
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   977
    ^ self someMenuItemLabeled:aLabel ifNone:nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   978
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   979
    "Created: / 14.11.1997 / 20:55:17 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   980
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   981
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   982
someMenuItemLabeled:aLabel ifNone:exceptionBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   983
    "get the menu item labeled aLabel; in case that the value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   984
     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
   985
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   986
    |item|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   987
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   988
    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   989
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   990
    item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   991
	^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   992
    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   993
    ^ exceptionBlock value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   994
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   995
    "Created: / 14.11.1997 / 20:56:13 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   996
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   997
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   998
someMenuItemWithValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   999
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1000
     is not found nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1001
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1002
    ^ self someMenuItemWithValue:aValue ifNone:nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1003
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1004
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1005
someMenuItemWithValue:aValue ifNone:exceptionBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1006
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1007
     is not found, the given exceptionBlock is executed and returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1008
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1009
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1010
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1011
    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1012
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1013
    item notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1014
	^ item
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1015
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1016
  ^ exceptionBlock value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1017
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1018
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1019
!Menu methodsFor:'queries'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1020
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1021
hasHiddenItems
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1022
    "test whether any item is hidden"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1023
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1024
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
  1025
	anItem isHidden ifTrue:[^ true]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1026
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1027
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1028
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1029
    "Modified: / 27.10.1997 / 15:12:44 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1030
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1031
2584
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1032
hasItems
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1033
    "test whether there are any menu-items"
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1034
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1035
    ^ items notEmptyOrNil
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1036
!
5b5c3dda9a4b +hasItems query
Claus Gittinger <cg@exept.de>
parents: 2494
diff changeset
  1037
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1038
hasSubMenuAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1039
    "test whether the menu item at the given index has a submenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1040
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1041
    ^ (self menuItemAt:anIndex) hasSubmenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1042
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
  1043
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1044
!Menu methodsFor:'startup'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1045
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1046
show
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1047
    "realize the menu at its last position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1048
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1049
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1050
    ^ (MenuPanel menu:self) show ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1051
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1052
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1053
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1054
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1055
showAt:aPoint
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1056
    "realize the menu at aPoint; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1057
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1058
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1059
    ^ self showAt:aPoint resizing:true
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1060
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1061
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1062
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1063
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1064
showAt:aPoint resizing:aBoolean
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1065
    "realize the menu at aPoint; returns the value associated with the
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1066
     selected item, 0 if none was selected"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1067
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1068
    ^ ((MenuPanel menu:self) showAt:aPoint resizing:aBoolean) ? 0
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1069
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1070
    "Modified: / 8.7.1998 / 19:57:55 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1071
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1072
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1073
showAtPointer
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1074
    "realize the menu at the current pointer position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1075
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1076
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1077
    ^ self startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1078
!
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
  1079
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1080
showCenteredIn:aView
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1081
    "realize the menu visible at the aView center; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1082
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1083
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1084
    ^ ((MenuPanel menu:self) showCenteredIn:aView) ? 0
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1085
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
  1086
    "Modified: / 8.7.1998 / 19:58:05 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1087
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1088
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1089
startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1090
    "display the menu as a popUp; returns the value associated with the
2039
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1091
     selected item, nil if none was selected.
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1092
     (should we return 0 form ST-80 compatibility ?)"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
  1093
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1094
    ^ (MenuPanel menu:self) startUp "/ ? 0
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1096
"   
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1097
        |m|
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1098
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1099
        m := #(#Menu #(
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1100
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1101
                                #rawLabel: 'left' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1102
                                #value: #left ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1103
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1104
                                #rawLabel: 'center' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1105
                                #value: #center ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1106
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1107
                                #rawLabel: 'right' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1108
                                #value: #right ) ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1109
                 #(2) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1110
                nil 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1111
        ) decodeAsLiteralArray.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1112
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1113
      Transcript showCR:(m startUp)        
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
  1114
"
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1115
!
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1116
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1117
startUpAt:aPoint
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1118
    "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
  1119
     selected item, 0 if none was selected"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1120
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1121
    ^ ((MenuPanel menu:self) startUpAt:aPoint) ? 0
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1122
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1123
"   
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1124
        |m|
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1125
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1126
        m := #(#Menu #(
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1127
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1128
                                #rawLabel: 'left' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1129
                                #value: #left ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1130
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1131
                                #rawLabel: 'center' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1132
                                #value: #center ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1133
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1134
                                #rawLabel: 'right' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1135
                                #value: #right ) ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1136
                 #(2) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1137
                nil 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1138
        ) decodeAsLiteralArray.
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1139
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1140
      Transcript showCR:(m startUpAt:100@100)        
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1141
"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1142
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
  1143
    "Created: / 21.5.1998 / 14:15:21 / cg"
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
  1144
    "Modified: / 21.5.1998 / 14:17:46 / cg"
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1145
!
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1146
1652
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1147
startUpFor:originatingWidget
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1148
    "display the menu as a popUp; returns the value associated with the
2039
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1149
     selected item, nil if none was selected.
30187ff89c64 comment
Claus Gittinger <cg@exept.de>
parents: 2017
diff changeset
  1150
     (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
  1151
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1152
    ^ (MenuPanel menu:self) startUpFor:originatingWidget "/ ? 0
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1153
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1154
"   
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1155
        |m|
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1156
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1157
        m := #(#Menu #(
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1158
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1159
                                #rawLabel: 'left' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1160
                                #value: #left ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1161
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1162
                                #rawLabel: 'center' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1163
                                #value: #center ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1164
                        #(#MenuItem 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1165
                                #rawLabel: 'right' 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1166
                                #value: #right ) ) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1167
                 #(2) 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1168
                nil 
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1169
        ) decodeAsLiteralArray.
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1170
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1171
      Transcript showCR:(m startUp)        
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1172
"
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1173
!
e2a96fa70eef can now specify if menu action is to be performed by
ca
parents: 1620
diff changeset
  1174
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1175
startUpOrNil
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1176
    "display the menu as a popUp; returns the value associated with the
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1177
     selected item, nil if none was selected"
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
  1178
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
  1179
    ^ (MenuPanel menu:self) startUpOrNil
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1180
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1181
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1182
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1183
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1184
version
2814
f75f27d92a5b changed: #addSeparator
Claus Gittinger <cg@exept.de>
parents: 2764
diff changeset
  1185
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.74 2009-12-04 13:38:27 cg Exp $'
2764
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
  1186
!
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
  1187
c83f22018324 squeak oompatibility:
Claus Gittinger <cg@exept.de>
parents: 2751
diff changeset
  1188
version_CVS
2814
f75f27d92a5b changed: #addSeparator
Claus Gittinger <cg@exept.de>
parents: 2764
diff changeset
  1189
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.74 2009-12-04 13:38:27 cg Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1190
! !