Menu.st
author Claus Gittinger <cg@exept.de>
Wed, 05 Sep 2001 13:57:13 +0200
changeset 1500 367e30b243cd
parent 1405 c7775c10e8fd
child 1525 9008957b8ff7
permissions -rw-r--r--
added #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
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    12
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    13
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    14
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
    15
"{ Package: 'stx:libview2' }"
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
    16
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
Object subclass:#Menu
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    18
	instanceVariableNames:'items groupSizes receiver'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	category:'Views-Support'
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
1354
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    26
copyright
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    27
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    28
 COPYRIGHT (c) 1997 by eXept Software AG
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    29
              All Rights Reserved
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    30
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    31
 This software is furnished under a license and may be used
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    32
 only in accordance with the terms of that license and with the
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    34
 be provided or otherwise made available to, or used by, any
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    35
 other person.  No title to or ownership of the software is
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    36
 hereby transferred.
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    37
"
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    38
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    39
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    40
!
0c7e6c83b440 copyrights
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
    41
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
documentation
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    not yet finished Menu class - this will eventually replace
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    most of the MenuView and PopUpMenu stuff.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    (and hopefully be ST-80 compatible ...)
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    For now, only a subset of the full protocol is implemented.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    [author:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    51
	Claus Gittinger
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    [see also:]
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    54
	MenuItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
    55
	PopUpMenu
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    59
!Menu class methodsFor:'instance creation'!
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    60
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    61
labelArray:arrayOfString lines:linesArray values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    62
    "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
    63
     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
    64
     The valueArray contains value objects for each menu item 
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    65
     (or is nil if no value objects are specified)."
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    66
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    67
    |nLabel valueArray menuItems groupLengths|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    68
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    69
    nLabel := arrayOfString size.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    70
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    71
    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
    72
        (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
    73
            valueArray := #()
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
    74
        ] ifFalse:[
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 := (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
    76
        ]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    77
    ] 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
    78
        valueArray := valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    79
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    80
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    81
    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
    82
        ^ self error: 'illegal menu combination'
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    83
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    84
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    85
    menuItems := Array new:nLabel.
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    86
    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
    87
        |mi v|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    88
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    89
        mi := MenuItem labeled:(arrayOfString at:i) asString.
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    90
        v := valueArray at:i.
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    91
        (v isKindOf:Menu) ifTrue:[mi submenu:v].
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    92
        menuItems at:i put:mi
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    93
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    94
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    95
    (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
    96
        groupLengths := (menuItems isEmpty)
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    97
                            ifTrue: [Array new:0]
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
    98
                            ifFalse: [Array with:menuItems size]
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
    99
    ] ifFalse:[
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   100
        groupLengths := Array new:(linesArray size + 1).
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   101
        groupLengths at:1 put:linesArray first.
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   102
        2 to:linesArray size do: [:i | 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   103
            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
   104
        ].
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   105
        groupLengths at:groupLengths size put:(menuItems size - linesArray last).
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   106
    ].
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   107
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   108
    ^ self new 
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   109
        menuItems:menuItems 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   110
        menuItemGroups:groupLengths 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   111
        values:valueArray
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   112
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   113
    "Modified: / 19.4.1998 / 11:30:18 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   114
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   115
1174
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   116
labelArray:arrayOfString values:valueArrayOrNil
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   117
    "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
   118
     The valueArray contains value objects for each menu item 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   119
     (or is nil if no value objects are specified)."
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   120
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   121
    ^ self 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   122
        labelArray:arrayOfString 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   123
        lines:nil 
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   124
        values: valueArrayOrNil
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   125
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   126
!
f58d5c8cee82 added #labelArray:values: (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   127
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   128
labelList:arrayOfGroupStrings values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   129
    |labels lines|
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   130
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   131
    lines := arrayOfGroupStrings collect:[:each | each size].
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   132
    labels := OrderedCollection new.
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   133
    arrayOfGroupStrings do:[:group | labels addAll:group].
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   134
    ^ self labelArray:labels lines:lines values:valueArrayOrNil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   135
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   136
    "Modified: 20.6.1997 / 10:46:45 / cg"
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   137
    "Created: 13.9.1997 / 10:35:46 / cg"
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   138
!
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   139
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   140
labels:aString lines:linesArray values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   141
    ^ self 
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   142
	labelArray:(aString asCollectionOfLines)
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   143
	lines:linesArray
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   144
	values:valueArrayOrNil
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   145
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   146
    "Created: / 31.10.1997 / 03:12:20 / cg"
738
f7e6b6cd3855 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 737
diff changeset
   147
    "Modified: / 31.10.1997 / 03:23:42 / cg"
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   148
! !
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   149
1308
c29f450cf3ca category renamining
Claus Gittinger <cg@exept.de>
parents: 1247
diff changeset
   150
!Menu methodsFor:'Compatibility - ST80'!
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   151
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   152
indexOfMenuItem:anItem
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   153
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   154
    ^ items indexOf:anItem
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   155
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   156
    "Created: / 27.10.1997 / 16:34:19 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   157
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   158
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   159
menuButtons
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   160
    "ST-80 seems to use a special menuButton class here.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   161
     Here, kludge a collection of menuItems."
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   162
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   163
    ^ items
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   164
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   165
    "Created: / 27.10.1997 / 16:33:35 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   166
! !
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   167
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
!Menu methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   170
atNameKey:aNameKey
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   171
    "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
   172
     Searches in allItems (i.e. also in subMenus)"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   173
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   174
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   175
	anItem nameKey == aNameKey ifTrue:[^ anItem]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   176
    ].
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   177
    ^ nil
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   178
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   179
    "Modified: / 27.10.1997 / 15:12:00 / cg"
696
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   180
!
a49928754789 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 679
diff changeset
   181
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   182
groupSizes
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   183
    "return the value of the instance variable 'groupSizes' (automatically generated)"
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   184
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   185
    ^ groupSizes
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   186
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   187
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   188
groupSizes:something
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   189
    "set the value of the instance variable 'groupSizes' (automatically generated)"
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   190
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   191
    groupSizes := something.
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   192
!
578
7e0f62d9bc47 access methods ...
ca
parents: 494
diff changeset
   193
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   194
labelAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   195
    "gets the label of the menu item at the given index or nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   196
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   197
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   198
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   199
    (item := self menuItemAt:anIndex) notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   200
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   201
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   202
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   203
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   204
    "Modified: / 2.2.1998 / 13:28:32 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   205
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   206
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   207
labelAtValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   208
    "gets the label of the menu item assigned to value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   209
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   210
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   211
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   212
    item := self menuAndSubmenusDetectItem:[:anItem | anItem value == aValue ].
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   213
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   214
    item notNil ifTrue:[
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   215
        ^ item label
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   216
    ].
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   217
    ^ nil
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   218
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   219
    "Modified: / 2.2.1998 / 13:28:28 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   220
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   221
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
labels
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
    "return a collection of labels from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   225
    items isNil ifTrue:[^ #()].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
    ^ items collect:[:anItem | anItem label]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   228
    "Created: / 25.2.1997 / 19:47:53 / cg"
977
e07277070839 return valid collection in #labels.
Claus Gittinger <cg@exept.de>
parents: 972
diff changeset
   229
    "Modified: / 19.6.1998 / 02:36:22 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   232
lastItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   233
    "returns last item
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   234
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   235
    ^ items notNil ifTrue:[items last] ifFalse:[nil]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   236
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   237
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   238
lines
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   239
    "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
   240
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   241
    |lines groupSz|
737
c8bdd9dd8906 st80 stuff
Claus Gittinger <cg@exept.de>
parents: 729
diff changeset
   242
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   243
    (groupSz := groupSizes size) <= 1 ifTrue: [^ Array new].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   244
    lines := Array new:(groupSz - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   245
    lines at:1 put:groupSizes first.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   246
    2 to:(groupSz-1) do:[:i |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   247
        lines at:i put:(lines at:(i - 1)) + (groupSizes at:i)
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   248
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   249
    ^ lines
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   250
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   251
    "Modified: / 2.2.1998 / 13:28:19 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   252
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   253
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   254
menuItemAt:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   255
    "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
   256
     nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   257
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   258
    (index > 0 and:[index <= items size]) ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   259
	^ items at:index
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   260
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   261
  ^ nil
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   262
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   263
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   264
menuItemLabeled:anItemLabel
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   265
    "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
   266
     Searches all items (i.e. also submenu items)"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   267
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   268
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   269
		|l|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   270
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   271
		((l := anItem label) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   272
		    ^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   273
		].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   274
		(l includes:$&) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   275
		    ((l copyWithout:$&) sameAs: anItemLabel) ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   276
			^ anItem
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   277
		    ]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   278
		]
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   279
	     ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   280
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   281
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   282
    "Created: / 13.9.1997 / 10:25:16 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   283
    "Modified: / 27.10.1997 / 15:23:33 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   284
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   285
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   286
menuItems
1327
b0b482a84570 menuItems always returns a collection (never nil)
Claus Gittinger <cg@exept.de>
parents: 1308
diff changeset
   287
    ^ items ? #()
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   288
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   289
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   290
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
   291
    |n|
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   292
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
    items := aCollectionOfMenuItems.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   294
    groupSizes := sizes.
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   295
    sizes size > 0 ifTrue:[
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   296
        n := sizes inject:0 into:[:sumSoFar :this | sumSoFar + this].
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   297
        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
   298
            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
   299
        ]
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   300
    ].
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   302
    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
   303
        items with:values do:[:anItem :aValue |anItem value:aValue]
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   304
    ].
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   305
900
aa93395cdb55 care for empty group at the end (avoid line at end of menu)
Claus Gittinger <cg@exept.de>
parents: 801
diff changeset
   306
    "Modified: / 19.4.1998 / 11:47:34 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
1116
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   309
menuPerformer:something
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   310
    "set the receiver of the menu messages"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   311
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   312
    receiver := something.
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   313
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   314
    "Modified: / 2.2.1998 / 13:26:29 / cg"
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   315
!
2b08dc4f8ae1 checkin from browser
tm
parents: 1111
diff changeset
   316
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   317
numberOfItems
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   318
    "return the number of items in this menu"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   319
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   320
    ^ items size
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   321
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   322
    "Created: / 6.3.1997 / 15:15:53 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   323
    "Modified: / 2.2.1998 / 13:26:40 / cg"
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   324
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   325
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   326
receiver
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   327
    "return the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   328
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   329
    ^ receiver
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   330
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   331
    "Modified: / 2.2.1998 / 13:26:20 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   332
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   333
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   334
receiver:something
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   335
    "set the receiver of the menu messages"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   336
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   337
    receiver := something.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   338
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   339
    "Modified: / 2.2.1998 / 13:26:29 / cg"
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   340
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   341
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
valueAt:index
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
    ^ (items at:index) value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
    "Created: 25.2.1997 / 19:49:41 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
494
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   350
valueAt:anIndex put:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   351
    "put value an an index"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   352
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   353
    (items at:anIndex) value:aValue
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   354
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   355
    "Created: 6.3.1997 / 15:15:48 / cg"
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   356
!
ce8c074d5e6b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 489
diff changeset
   357
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   358
values
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
    "return a collection of values from my items"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
    ^ items collect:[:anItem | anItem value]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
    "Created: 25.2.1997 / 19:49:29 / cg"
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   364
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   365
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   366
values:aCollectionOfValues
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   367
    "return a collection of values from my items"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   368
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   369
    |s|
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   370
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   371
    s := aCollectionOfValues readStream.
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   372
    self itemsDo:[:item |
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   373
        |val|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   374
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   375
        val := s next.
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   376
        item value:val
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   377
    ].
1111
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   378
    s atEnd ifFalse:[
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   379
        self halt:'not enough elements in value collection'
6c1084c56d7f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1029
diff changeset
   380
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   381
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   382
    "Created: / 27.10.1997 / 15:15:47 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   383
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   384
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   385
visibleMenuItemGroups
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   386
    |itemGroups visibleItemGroups nextItem|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   387
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   388
    itemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   389
    nextItem := 1.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   390
    groupSizes do:[:groupSize |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   391
        itemGroups addLast: (items copyFrom:nextItem to:nextItem + groupSize - 1).
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   392
        nextItem := nextItem + groupSize
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   393
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   394
    self hasHiddenItems ifFalse:[^ itemGroups].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   395
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   396
    "Remove the hidden items."
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   397
    visibleItemGroups := OrderedCollection new.
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   398
    itemGroups do:[:eachItemGroup |
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   399
        |visibleItemGroup|
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   400
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   401
        visibleItemGroup := eachItemGroup reject:[:eachMenuItem | eachMenuItem hidden].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   402
        visibleItemGroup isEmpty ifFalse:[
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   403
            visibleItemGroups addLast: visibleItemGroup
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   404
        ]
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   405
    ].
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   406
    ^ visibleItemGroups
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   407
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   408
    "Created: / 27.10.1997 / 15:07:50 / cg"
801
0b87e3ba8eaf comments
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   409
    "Modified: / 2.2.1998 / 13:25:52 / cg"
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
1397
47ac1d3e1df1 category changes
Claus Gittinger <cg@exept.de>
parents: 1367
diff changeset
   412
!Menu methodsFor:'accessing-resource'!
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   413
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   414
findGuiResourcesIn:aResourceContainerOrApplication
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   415
    "setup a resource owner
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   416
    "
1401
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   417
    ^ self 
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   418
        findGuiResourcesIn:aResourceContainerOrApplication 
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   419
        rememberResourcesIn:(ValueHolder new)
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   420
!
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   421
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   422
findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:aValueHolderOrNil
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   423
    "setup a resource owner
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   424
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   425
    aResourceContainerOrApplication notNil ifTrue:[
1401
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   426
        items notNil ifTrue:[
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   427
            items do:[:anItem | 
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   428
                anItem 
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   429
                    findGuiResourcesIn:aResourceContainerOrApplication 
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   430
                    rememberResourcesIn:aValueHolderOrNil
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   431
            ]
0fda9891ba4a only ask once for resources (remember locally)
Claus Gittinger <cg@exept.de>
parents: 1397
diff changeset
   432
        ]
582
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   433
    ]
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   434
! !
94f55f6a8bad support of ResourceRetriver
ca
parents: 579
diff changeset
   435
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   436
!Menu methodsFor:'adding & removing'!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   437
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   438
addItem:aMenuItem
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   439
    "add a menuItem at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   440
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   441
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   442
    items isNil ifTrue:[
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   443
        items := OrderedCollection new
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   444
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   445
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   446
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   447
    items add:aMenuItem.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   448
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   449
    "Modified: / 4.8.1998 / 17:31:13 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   450
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   451
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   452
addItem:aMenuItem beforeIndex:anIndex
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   453
    "add a menuItem at some position;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   454
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   455
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   456
    items isNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   457
        items := OrderedCollection new
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   458
    ] ifFalse:[
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   459
        items := items asOrderedCollection
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   460
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   461
    items add:aMenuItem beforeIndex:anIndex.
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   462
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   463
    "Modified: / 4.8.1998 / 17:31:39 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   464
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   465
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   466
addItem:aMenuItem value:aValue
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   467
    aMenuItem value:aValue.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   468
    self addItem:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   469
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   470
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   471
addItemGroup:aCollectionOfItems
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   472
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   473
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   474
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   475
    groupSizes isNil ifTrue:[
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   476
        groupSizes := OrderedCollection new
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   477
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   478
    groupSizes add:aCollectionOfItems size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   479
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   480
    aCollectionOfItems do:[:item |
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   481
        self addItem:item
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   482
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   483
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   484
    "Created: / 27.10.1997 / 15:02:15 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   485
    "Modified: / 4.8.1998 / 17:32:06 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   486
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   487
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   488
addItemGroup:aGroup values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   489
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   490
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   491
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   492
    groupSizes isNil ifTrue:[
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   493
        groupSizes := OrderedCollection new
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   494
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   495
    groupSizes add:items size.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   496
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   497
    aGroup with:values do:[:item :value |
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   498
        self addItem:item value:value
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   499
    ].
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   500
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   501
    "Modified: / 4.8.1998 / 17:32:18 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   502
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   503
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   504
addItemGroupLabels:labels values:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   505
    "add a group of items at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   506
     useful to build a menu programmatically (or, to add more items dynamically)"
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   507
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   508
    |items|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   509
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   510
    items := labels with:values
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   511
                collect:[:label :value | 
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   512
                            MenuItem label:label value:value
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   513
                        ].
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   514
    self addItemGroup:items
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   515
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   516
    "Created: / 27.10.1997 / 19:49:27 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   517
    "Modified: / 4.8.1998 / 17:35:22 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   518
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   519
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   520
addItemLabel:label value:value
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   521
    "add an item at the end;
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   522
     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
   523
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   524
    self addItem:(MenuItem label:label value:value)
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   525
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   526
    "Created: / 27.10.1997 / 19:47:12 / cg"
1029
c77fe01f61a4 comments added;
Claus Gittinger <cg@exept.de>
parents: 996
diff changeset
   527
    "Modified: / 4.8.1998 / 17:34:44 / cg"
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   528
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   529
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   530
addSeparator
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   531
    "add a separating line item at the end;
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   532
     useful to build a menu programmatically (or, to add more items dynamically)"
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   533
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   534
    self addItem:(MenuItem new label:'-').
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   535
!
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   536
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   537
removeItem:aMenuItem
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   538
    "remove an item from the menu"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   539
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   540
    |idx|
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   541
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   542
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   543
        idx := items identityIndexOf:aMenuItem.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   544
        idx ~~ 0 ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   545
            items removeAtIndex:idx
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   546
        ]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   547
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   548
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   549
    "Created: / 13.9.1997 / 10:27:31 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   550
    "Modified: / 2.2.1998 / 13:26:49 / cg"
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   551
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   552
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   553
removeItemAt:anIndex
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   554
    "remove item at an index
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   555
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   556
    anIndex <= items size ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   557
        ^ items removeAtIndex:anIndex
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
    ^ nil
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   560
! !
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   561
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
!Menu methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    |items groups values|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   569
"/    ((aLiteralEncodedArray at:2) at:1) == #OrderedCollection ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   570
"/        items := (aLiteralEncodedArray at:2) decodeAsLiteralArray
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   571
"/    ] ifFalse:[
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
    items := (aLiteralEncodedArray at:2) collect:[:item | item decodeAsLiteralArray].
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   573
"/    ].
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   574
    groups := aLiteralEncodedArray at:3 ifAbsent:nil.
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   575
    values := aLiteralEncodedArray at:4 ifAbsent:nil.
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   576
    self menuItems:items menuItemGroups:groups values:values.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   578
    "extract from PD folder.st:
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   580
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   581
                        #rawLabel: 'left' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   582
                        #value: #left ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   583
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   584
                        #rawLabel: 'center' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   585
                        #value: #center ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   586
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   587
                        #rawLabel: 'right' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   588
                        #value: #right ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   589
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   590
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   591
             nil 
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
       ) decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
    "
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   594
    "
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   595
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   596
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   597
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   598
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   599
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   600
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   601
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   602
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   603
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   604
            #(#straightenUp #inspect #halt ) 
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   605
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   606
    "
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   607
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   608
    "extract from iconicBrowser.st:
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   609
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   610
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   611
                        #label: 'Straighten Up' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   612
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   613
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   614
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   615
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   616
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   617
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   618
             #(1 2 3 )
452
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   619
       ) decodeAsLiteralArray startUp  
b708d60b96b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   620
    "
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   622
    "extract from refactory213.st:
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   623
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   624
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   625
                    #label: 'File List' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   626
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   627
                #(#MenuItem #label: 'File Editor...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   628
                    #accessCharacterPosition: 6 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   629
                #(#MenuItem #label: 'Refactoring Tool...' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   630
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   631
                #(#MenuItem #label: 'Workspace' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   632
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   633
                #(#MenuItem #label: 'New Canvas' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   634
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   635
                #(#MenuItem #label: 'Palette' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   636
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   637
                #(#MenuItem #label: 'Canvas Tool' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   638
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   639
                #(#MenuItem #label: 'Image Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   640
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   641
                #(#MenuItem #label: 'Menu Editor' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   642
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   643
                #(#MenuItem #label: 'Advanced' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   644
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   645
                #(#MenuItem #label: 'DLL and C Connect' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   646
                    #accessCharacterPosition: 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   647
                #(#MenuItem #label: 'System Transcript' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   648
                    #accessCharacterPosition: 8 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   649
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   650
              #(4 5 2 1 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   651
              #(#openFileList #openFileEditor #openRefactoringTool #toolsNewWorkspace #toolsNewCanvas #toolsPalette #toolsCanvasTool #toolsMaskEditor #toolsMenuEditor nil #openExternalFinder #toggleSystemTranscript ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   652
        ) decodeAsLiteralArray startUp
454
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   653
    "
539b7c318760 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 452
diff changeset
   654
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   655
    "submenus:
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   656
     #(#Menu #(
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   657
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   658
                        #label: 'Foo' 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   659
                        #submenu: #(#Menu #(
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   660
                                            #(#MenuItem #label: 'foo 1')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   661
                                            #(#MenuItem #label: 'foo 2')     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   662
                                          )
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   663
                                          nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   664
                                          #(11 22)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   665
                                   )     
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   666
                 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   667
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   668
                        #label: 'Inspect' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   669
                #(#MenuItem 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   670
                        #label: 'Coredump' ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   671
              ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   672
             #(3 ) 
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   673
             #(1 2 3 )
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   674
       ) decodeAsLiteralArray startUp  
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   675
    "
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   676
610
72dbf392e888 ST80 compatible inst creation method..
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
   677
    "Modified: 20.6.1997 / 10:45:51 / cg"
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   678
!
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   679
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   680
literalArrayEncoding
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   681
    "return myself encoded as a literal array"
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   682
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   683
    |coll array size|
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   684
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   685
    coll := OrderedCollection new.
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   686
    coll add:#Menu.
1245
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   687
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   688
    (size := items size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   689
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   690
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   691
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   692
        items keysAndValuesDo:[:anIndex :anItem|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   693
            array at:anIndex put:(anItem literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   694
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   695
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   696
    coll add:array.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   697
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   698
    (size := groupSizes size) == 0  ifTrue:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   699
        array := nil
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   700
    ] ifFalse:[
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   701
        array := Array new:size.
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   702
        groupSizes keysAndValuesDo:[:anIndex :aSize|
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   703
            array at:anIndex put:(aSize literalArrayEncoding)
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   704
        ]
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   705
    ].
93d262fccc63 bugFix in
ca
parents: 1174
diff changeset
   706
    coll add:array.
489
264ba86c52c1 checkin from browser
ca
parents: 457
diff changeset
   707
    coll add:nil.
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   708
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   711
!Menu methodsFor:'enumerating'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   712
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   713
allItemsDo:aOneArgBlock
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   714
    "evaluate block on each item and submenu items
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   715
    "
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   716
    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
   717
        |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   718
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   719
        aOneArgBlock value:anItem.
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   720
        (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
   721
            sub allItemsDo:aOneArgBlock
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   722
        ]
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   723
    ]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   724
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   725
    "Modified: / 19.6.1998 / 00:34:53 / cg"
665
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   726
!
9e8b4bc9fedb enumerating:
ca
parents: 627
diff changeset
   727
940
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   728
detectItem:aBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   729
    "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
   730
     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
   731
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   732
     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
   733
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   734
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   735
    ^ self detectItem:aBlock ifNone:[self errorNotFound]
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   736
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   737
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   738
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   739
detectItem:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   740
    "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
   741
     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
   742
     true evaluation.
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   743
     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
   744
     evaluation of the exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   745
    "
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   746
    items notNil ifTrue:[
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   747
        ^ items detect:aBlock ifNone:exceptionBlock
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   748
    ].
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   749
    ^ exceptionBlock value
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   750
!
418cfd9b298d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 939
diff changeset
   751
589
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   752
itemsDo:aOneArgBlock
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   753
    "evaluate the block for each item in the current menu
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   754
    "
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   755
    items notNil ifTrue:[items do:aOneArgBlock]
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   756
!
cc422fe7824f ST-80 compatibility; enumerating & indication
ca
parents: 584
diff changeset
   757
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   758
menuAndSubmenusDetectItem:aOneArgBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   759
    "evaluate the block for each item in the current menu and all
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   760
     submenus. In case that the block returns a non nil argument,
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   761
     the item will be returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   762
    "
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   763
    |item|
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   764
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   765
    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
   766
        items do:[:anItem|
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   767
            |sub|
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   768
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   769
            (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
   770
                ^ anItem
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   771
            ].
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   772
            (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
   773
                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
   774
                item notNil ifTrue:[
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   775
                    ^ item
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   776
                ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   777
            ]
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   778
        ]
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   779
    ].
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   780
    ^ nil
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   781
972
09bc0765dbc1 no need to send submenu value - the item does it now.
Claus Gittinger <cg@exept.de>
parents: 950
diff changeset
   782
    "Modified: / 19.6.1998 / 00:35:00 / cg"
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   783
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   784
672
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   785
!Menu methodsFor:'kludged fixes'!
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   786
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   787
destroy
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   788
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   789
    "Created: 28.7.1997 / 10:16:52 / cg"
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   790
! !
2db4bb41aa93 added dummy #destroy (q&d hack)
Claus Gittinger <cg@exept.de>
parents: 665
diff changeset
   791
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   792
!Menu methodsFor:'menu items'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   793
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   794
someMenuItemLabeled:aLabel
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   795
    "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
   796
     is not found, nil is returned
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   797
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   798
    ^ self someMenuItemLabeled:aLabel ifNone:nil
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   799
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   800
    "Created: / 14.11.1997 / 20:55:17 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   801
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   802
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   803
someMenuItemLabeled:aLabel ifNone:exceptionBlock
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   804
    "get the menu item labeled aLabel; in case that the value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   805
     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
   806
    "
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   807
    |item|
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   808
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   809
    item := self menuAndSubmenusDetectItem:[:anItem| anItem label = aLabel].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   810
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   811
    item notNil ifTrue:[
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   812
	^ item
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   813
    ].
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   814
    ^ exceptionBlock value
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   815
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   816
    "Created: / 14.11.1997 / 20:56:13 / cg"
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   817
!
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   818
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   819
someMenuItemWithValue:aValue
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   820
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   821
     is not found nil is returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   822
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   823
    ^ self someMenuItemWithValue:aValue ifNone:nil
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   824
!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   825
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   826
someMenuItemWithValue:aValue ifNone:exceptionBlock
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   827
    "get the menu item assigned with the value; in case that the value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   828
     is not found, the given exceptionBlock is executed and returned
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   829
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   830
    |item|
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   831
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   832
    item := self menuAndSubmenusDetectItem:[:anItem| anItem value == aValue].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   833
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   834
    item notNil ifTrue:[
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   835
	^ item
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   836
    ].
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   837
  ^ exceptionBlock value
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   838
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   839
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   840
!Menu methodsFor:'queries'!
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   841
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   842
hasHiddenItems
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   843
    "test whether any item is hidden"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   844
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   845
    self allItemsDo:[:anItem|
740
4f45cc61d4e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 739
diff changeset
   846
	anItem isHidden ifTrue:[^ true]
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   847
    ].
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   848
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   849
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   850
    "Modified: / 27.10.1997 / 15:12:44 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   851
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
   852
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   853
hasSubMenuAt:anIndex
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   854
    "test whether the menu item at the given index has a submenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   855
    "
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   856
    ^ (self menuItemAt:anIndex) hasSubmenu
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   857
! !
9a4c30f7586f ST-80 compatible features addded
ca
parents: 582
diff changeset
   858
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
!Menu methodsFor:'startup'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   861
show
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   862
    "realize the menu at its last position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   863
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   864
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   865
    ^ (MenuPanel menu:self) show ? 0
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   866
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   867
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   868
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   869
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   870
showAt:aPoint
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   871
    "realize the menu at aPoint; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   872
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   873
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   874
    ^ self showAt:aPoint resizing:true
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   875
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   876
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   877
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   878
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   879
showAt:aPoint resizing:aBoolean
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   880
    "realize the menu at aPoint; returns the value associated with the
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
     selected item, 0 if none was selected"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   883
    ^ ((MenuPanel menu:self) showAt:aPoint resizing:aBoolean) ? 0
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   884
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   885
    "Modified: / 8.7.1998 / 19:57:55 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   886
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   887
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   888
showAtPointer
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   889
    "realize the menu at the current pointer position; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   890
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   891
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   892
    ^ self startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   893
!
457
19f2c28e4adb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 456
diff changeset
   894
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   895
showCenteredIn:aView
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   896
    "realize the menu visible at the aView center; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   897
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   898
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   899
    ^ ((MenuPanel menu:self) showCenteredIn:aView) ? 0
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   900
996
1e10d01c90b8 careful: ? is a binary selector.
Claus Gittinger <cg@exept.de>
parents: 977
diff changeset
   901
    "Modified: / 8.7.1998 / 19:58:05 / cg"
729
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   902
!
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   903
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   904
startUp
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   905
    "display the menu as a popUp; returns the value associated with the
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   906
     selected item, 0 if none was selected"
7e22cc23fd1f bugfix:
ca
parents: 724
diff changeset
   907
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   908
    ^ (MenuPanel menu:self) startUp "/ ? 0
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   909
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   910
"   
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   911
        |m|
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   912
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   913
        m := #(#Menu #(
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   914
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   915
                                #rawLabel: 'left' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   916
                                #value: #left ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   917
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   918
                                #rawLabel: 'center' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   919
                                #value: #center ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   920
                        #(#MenuItem 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   921
                                #rawLabel: 'right' 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   922
                                #value: #right ) ) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   923
                 #(2) 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   924
                nil 
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   925
        ) decodeAsLiteralArray.
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   926
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   927
      Transcript showCR:(m startUp)        
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   928
"
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   929
!
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   930
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   931
startUpAt:aPoint
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   932
    "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
   933
     selected item, 0 if none was selected"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   934
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   935
    ^ ((MenuPanel menu:self) startUpAt:aPoint) ? 0
938
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   936
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   937
"   
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   938
        |m|
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   939
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   940
        m := #(#Menu #(
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   941
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   942
                                #rawLabel: 'left' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   943
                                #value: #left ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   944
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   945
                                #rawLabel: 'center' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   946
                                #value: #center ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   947
                        #(#MenuItem 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   948
                                #rawLabel: 'right' 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   949
                                #value: #right ) ) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   950
                 #(2) 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   951
                nil 
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   952
        ) decodeAsLiteralArray.
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   953
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   954
      Transcript showCR:(m startUpAt:100@100)        
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   955
"
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   956
dfa1b1666cfa added #startUpAt: (MenuView compatibility)
Claus Gittinger <cg@exept.de>
parents: 900
diff changeset
   957
    "Created: / 21.5.1998 / 14:15:21 / cg"
939
f6df8fbf6b4a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 938
diff changeset
   958
    "Modified: / 21.5.1998 / 14:17:46 / cg"
1367
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   959
!
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   960
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   961
startUpOrNil
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   962
    "display the menu as a popUp; returns the value associated with the
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   963
     selected item, nil if none was selected"
37bf7a7b5bd1 compatibility stuff
Claus Gittinger <cg@exept.de>
parents: 1354
diff changeset
   964
1405
c7775c10e8fd tolerant literalDecoding (missing 2nd and 3rd elements);
Claus Gittinger <cg@exept.de>
parents: 1401
diff changeset
   965
    ^ (MenuPanel menu:self) startUpOrNil
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   967
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
!Menu class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   970
version
1500
367e30b243cd added #addSeparator
Claus Gittinger <cg@exept.de>
parents: 1405
diff changeset
   971
    ^ '$Header: /cvs/stx/stx/libview2/Menu.st,v 1.48 2001-09-05 11:57:13 cg Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   972
! !