MenuItem.st
author tz
Fri, 09 Jan 1998 16:50:18 +0100
changeset 752 93690dcd1b75
parent 724 898519684261
child 794 432935e754e0
permissions -rw-r--r--
button and label translation support added.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
Object subclass:#MenuItem
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
     2
	instanceVariableNames:'activeHelpKey enabled label value nameKey adornment
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
     3
		translateLabel isButton'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	category:'Views-Support'
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
Object subclass:#MenuItemAdornment
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
    10
	instanceVariableNames:'color indication submenu submenuChannel shortcutKey labelText
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    11
		labelImage accessCharacterPosition argument'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	privateIn:MenuItem
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
documentation
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
    not yet finished MenuItem class - this will eventually replace
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    most of the MenuView and PopUpMenu stuff.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
    (and hopefully be ST-80 compatible ...)
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
    For now, only a subset of the full protocol is implemented.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
    [author:]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
        Claus Gittinger
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
    [see also:]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
        MenuItem
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
        PopUpMenu
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    37
!MenuItem class methodsFor:'instance creation'!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    38
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    39
labeled:aString
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    40
    ^ self new label:aString
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    41
! !
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    42
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    43
!MenuItem methodsFor:'ST-80 compatibility'!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    44
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    45
isEnabled:aBoolean
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    46
    self enabled:aBoolean
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    47
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    48
    "Created: / 27.10.1997 / 16:34:55 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    49
! !
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
    50
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
!MenuItem methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    53
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    54
    "get the index of the access character in the label text or string, or nil if none
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    55
    "
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    56
    adornment notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    57
        ^ adornment accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    58
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    59
    ^ nil
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    62
accessCharacterPosition:index
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    63
    "set the index of the access character in the label text or string, or nil if none
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    64
    "
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    65
    (index isNil and:[adornment isNil]) ifFalse:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    66
        self adornment accessCharacterPosition:index
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    67
    ]
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
640
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    70
activeHelpKey
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    71
    ^ activeHelpKey
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    72
!
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    73
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    74
activeHelpKey:aKey
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    75
    activeHelpKey := aKey
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    76
!
4e1c0d0a633b add active help for items
ca
parents: 590
diff changeset
    77
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    78
argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    79
    "get argument given to the value (selector)
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    80
    "
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    81
    adornment notNil ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    82
        ^ adornment argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    83
    ].
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    84
    ^ nil
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    85
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    86
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    87
argument:something
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    88
    "set argument given to the value (selector)
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    89
    "
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    90
    |arg|
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    91
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    92
    (arg := something) notNil ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    93
        arg isString ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    94
            (arg size == 0 or:[(arg indexOfNonSeparatorStartingAt:1) == 0]) ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    95
                arg := nil
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    96
            ]
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    97
        ]
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    98
    ].
184dd159d02e support of arguments
ca
parents: 666
diff changeset
    99
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   100
    (arg isNil and:[adornment isNil]) ifFalse:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   101
        self adornment argument:arg
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   102
    ]
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   103
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   104
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    ^ label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    "Created: 25.2.1997 / 19:48:16 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
453
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   111
label:aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   112
    label := aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   113
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   114
    "Created: 25.2.1997 / 19:55:16 / cg"
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   115
!
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   116
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   117
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   118
    "gets the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   119
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   120
    adornment notNil ifTrue:[
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   121
        ^ adornment labelImage value
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   122
    ].
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   123
  ^ nil
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   124
!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   125
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   126
labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   127
    "set the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   128
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   129
    aResourceRetriever notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   130
        self adornment labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   131
    ]
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   132
!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   133
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   134
nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   135
    ^ nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   136
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   137
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   138
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   139
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   140
nameKey:aNameKey
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   141
    nameKey := aNameKey.
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   142
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   143
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   144
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   145
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   146
rawLabel
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   147
    ^ label
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   148
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   149
    "Created: 25.2.1997 / 19:48:16 / cg"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   150
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   151
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
rawLabel:aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
    label := aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
    "Created: 25.2.1997 / 19:11:02 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   158
shortcutKeyCharacter
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   159
    "ignored for now"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   160
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   161
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   162
        ^ adornment shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   163
    ].
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   164
    ^ nil
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   165
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   166
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   167
shortcutKeyCharacter:aKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   168
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   169
    "
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   170
    (aKey isNil and:[adornment isNil]) ifFalse:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   171
        self adornment shortcutKeyCharacter:aKey
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   172
    ]
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   173
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   174
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   175
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   176
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   177
        ^ adornment submenu
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   178
    ].
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   179
    ^ nil
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   180
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   181
    "Created: 25.2.1997 / 20:57:24 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   182
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   183
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   184
submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   185
    self adornment submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   186
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   187
    "Created: 25.2.1997 / 20:56:20 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   188
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   189
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   190
submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   191
    adornment notNil ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   192
        ^ adornment submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   193
    ].
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   194
    ^ nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   195
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   196
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   197
submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   198
    self adornment submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   199
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   200
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
    ^ value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
    "Created: 25.2.1997 / 19:50:14 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
value:something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
    value := something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
    "Created: 25.2.1997 / 19:11:13 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   213
!MenuItem methodsFor:'accessing behavior'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   214
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   215
beOff
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   216
    "set indication off
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   217
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   218
    self indication:false
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   219
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   220
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   221
beOn
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   222
    "set indication on
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   223
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   224
    self indication:true
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   225
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   226
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   227
disable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   228
    enabled := false
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   229
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   230
    "Created: 25.2.1997 / 19:39:09 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   231
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   232
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   233
enable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   234
    enabled := true
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   235
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   236
    "Created: 25.2.1997 / 19:39:00 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   237
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   238
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   239
enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   240
    "returns a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   241
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   242
    ^ enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   243
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   244
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   245
enabled:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   246
    "a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   247
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   248
    enabled := something
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   249
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   250
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   251
indication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   252
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   253
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   254
    adornment notNil ifTrue:[
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   255
        ^ adornment indication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   256
    ].
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   257
    ^ nil
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   258
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   259
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   260
indication:anIndication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   261
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   262
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   263
    (anIndication notNil or:[adornment notNil]) ifTrue:[
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   264
        self adornment indication:anIndication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   265
    ].
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   266
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   267
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   268
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   269
isButton
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   270
    "returns whether item looks like a Button
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   271
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   272
    ^isButton ? false
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   273
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   274
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   275
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   276
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   277
isButton:anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   278
    "sets whether item looks like a Button
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   279
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   280
    isButton := anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   281
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   282
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   283
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   284
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   285
translateLabel
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   286
    "returns whether label is translated
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   287
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   288
    ^translateLabel ? false
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   289
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   290
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   291
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   292
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   293
translateLabel:anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   294
    "sets whether label is translated
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   295
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   296
    translateLabel := anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   297
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   298
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   299
! !
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   300
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   301
!MenuItem methodsFor:'accessing resource'!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   302
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   303
findGuiResourcesIn:aResourceContainerOrApplication
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   304
    "setup a resource container
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   305
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   306
    |lblImg|
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   307
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   308
    self translateLabel ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   309
        label := ResourceRetriever findResourceLabel: label in: aResourceContainerOrApplication
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   310
    ].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   311
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   312
    adornment notNil ifTrue:[
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   313
        (lblImg := adornment labelImage) notNil ifTrue:[   
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   314
            lblImg findGuiResourcesIn:aResourceContainerOrApplication.
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   315
            lblImg labelText notNil ifTrue: [lblImg labelText: label].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   316
        ].   
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   317
        adornment submenu notNil ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   318
            adornment submenu findGuiResourcesIn:aResourceContainerOrApplication
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   319
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   320
    ]
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   321
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   322
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
!MenuItem methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
    2 to:aLiteralEncodedArray size by:2 do:[:i |
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
        |selector value|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
        selector := aLiteralEncodedArray at:i.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   332
        value    := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   333
        self perform:selector with:value
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
    ].
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
    "
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   337
     #( #MenuItem #rawLabel: 'left' #nameKey: 'identifier'  #value: #left )
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
         decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
    "
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
    "Modified: 25.2.1997 / 19:24:22 / cg"
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   342
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   343
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   344
literalArrayEncoding
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   345
    "return myself encoded as a literal array"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   346
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   347
    |coll something|
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   348
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   349
    coll := OrderedCollection new.
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   350
    coll add:#MenuItem.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   351
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   352
    label notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   353
        coll add:#label: ; add:(label literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   354
    ].
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   355
    self translateLabel ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   356
        coll add:#translateLabel: ; add:(translateLabel literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   357
    ].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   358
    self isButton ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   359
        coll add:#isButton:; add:(isButton literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   360
    ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   361
    nameKey notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   362
        coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   363
    ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   364
    value notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   365
        coll add:#value: ; add:(value literalArrayEncoding).
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   366
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   367
    activeHelpKey notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   368
        coll add:#activeHelpKey: ; add:(activeHelpKey literalArrayEncoding).
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   369
    ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   370
    (something := self enabled) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   371
        coll add:#enabled: ; add:(enabled literalArrayEncoding).
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   372
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   373
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   374
    adornment notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   375
        (something := self shortcutKeyCharacter) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   376
            coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   377
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   378
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   379
        (something := self accessCharacterPosition) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   380
            coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   381
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   382
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   383
        (something := self argument) notNil ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   384
            coll add:#argument: ; add:(something literalArrayEncoding)
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   385
        ].
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   386
661
c09ac6b9820d literalArrayEncoding
ca
parents: 653
diff changeset
   387
        adornment labelImage notNil ifTrue:[
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   388
            coll add:#labelImage: ; add:(adornment labelImage literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   389
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   390
        (something := self indication) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   391
            coll add:#indication: ; add:(something literalArrayEncoding)
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   392
        ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   393
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   394
        (something := self submenuChannel) notNil ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   395
            coll add:#submenuChannel: ; add:(something literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   396
        ].
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   397
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   398
        self hasSubmenu ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   399
            coll add:#submenu:; add:(self submenu literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   400
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   401
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   402
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   403
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   406
!MenuItem methodsFor:'private - accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   407
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   408
adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   409
    adornment isNil ifTrue:[
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   410
        adornment := MenuItemAdornment new
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   411
    ].
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   412
    ^ adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   413
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   414
    "Created: 25.2.1997 / 20:57:05 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   415
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   416
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   417
!MenuItem methodsFor:'queries'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   418
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   419
hasIndication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   420
    "test whether indication on/off exists
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   421
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   422
  ^ self indication notNil
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   423
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   424
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   425
hasSubmenu
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   426
    ^ self submenu notNil
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   427
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   428
    "Created: 25.2.1997 / 20:56:20 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   429
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   430
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   431
isEnabled
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   432
    ^ enabled value ? true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   433
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   434
    "Created: 25.2.1997 / 19:39:17 / cg"
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   435
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   436
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   437
isHidden
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   438
    "not yet supported"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   439
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   440
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   441
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   442
    "Created: / 27.10.1997 / 15:13:43 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   443
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   444
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   445
isOff
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   446
    "test whether indication on/off exists and is off
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   447
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   448
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   449
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   450
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   451
  ^ indication value == false
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   452
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   453
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   454
isOn
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   455
    "test whether indication on/off exists and is on
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   456
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   457
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   458
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   459
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   460
  ^ indication value == true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   461
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   462
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   463
!MenuItem::MenuItemAdornment methodsFor:'accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   464
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   465
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   466
    "return the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   467
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   468
    ^ accessCharacterPosition!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   469
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   470
accessCharacterPosition:something
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   471
    "set the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   472
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   473
    accessCharacterPosition := something.!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   474
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   475
argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   476
    "return the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   477
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   478
    ^ argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   479
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   480
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   481
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   482
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   483
argument:something
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   484
    "set the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   485
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   486
    argument := something.
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   487
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   488
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   489
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   490
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   491
color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   492
    "return the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   493
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   494
    ^ color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   495
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   496
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   497
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   498
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   499
color:something
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   500
    "set the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   501
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   502
    color := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   503
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   504
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   505
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   506
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   507
indication
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   508
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   509
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   510
    ^ indication
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   511
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   512
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   513
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   514
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   515
indication:something
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   516
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   517
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   518
    indication := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   519
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   520
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   521
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   522
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   523
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   524
    "return the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   525
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   526
    ^ labelImage!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   527
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   528
labelImage:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   529
    "set the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   530
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   531
    labelImage := something.!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   532
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   533
labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   534
    "get the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   535
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   536
    ^ labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   537
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   538
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   539
labelText:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   540
    "set the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   541
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   542
    labelText := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   543
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   544
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   545
shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   546
    "get the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   547
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   548
    ^ shortcutKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   549
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   550
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   551
shortcutKeyCharacter:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   552
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   553
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   554
    shortcutKey := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   555
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   556
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   557
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   558
    "get the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   559
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   560
    ^ submenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   561
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   562
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   563
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   564
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   565
submenu:something
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   566
    "set the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   567
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   568
    submenu := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   569
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   570
    "Created: 25.2.1997 / 20:59:28 / cg"
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   571
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   572
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   573
submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   574
    "get the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   575
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   576
    ^ submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   577
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   578
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   579
submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   580
    "set the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   581
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   582
    submenuChannel := something.
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   583
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   584
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
version
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   588
    ^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.18 1998-01-09 15:50:18 tz Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
! !