MenuItem.st
author tz
Sat, 07 Feb 1998 16:57:39 +0100
changeset 834 ac1655bd31bb
parent 798 8a27a879ff23
child 960 fee5a1a50374
permissions -rw-r--r--
class category changed
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
798
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
     3
		translateLabel isButton startGroup isVisible'
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
798
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   105
isVisible
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   106
    ^ isVisible ? true
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   107
!
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   108
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   109
isVisible:something
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   110
    isVisible := something
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   111
!
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   112
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    ^ label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    "Created: 25.2.1997 / 19:48:16 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
453
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   119
label:aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   120
    label := aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   121
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   122
    "Created: 25.2.1997 / 19:55:16 / cg"
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   123
!
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
   124
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   125
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   126
    "gets the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   127
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   128
    adornment notNil ifTrue:[
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   129
        ^ adornment labelImage value
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   130
    ].
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   131
  ^ nil
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
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   134
labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   135
    "set the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   136
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   137
    aResourceRetriever notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   138
        self adornment labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   139
    ]
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   140
!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   141
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   142
nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   143
    ^ nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   144
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   145
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   146
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   147
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   148
nameKey:aNameKey
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   149
    nameKey := aNameKey.
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   150
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   151
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   152
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   153
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   154
rawLabel
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   155
    ^ label
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   156
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   157
    "Created: 25.2.1997 / 19:48:16 / cg"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   158
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   159
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
rawLabel:aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
    label := aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
    "Created: 25.2.1997 / 19:11:02 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   166
shortcutKeyCharacter
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   167
    "ignored for now"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   168
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   169
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   170
        ^ adornment shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   171
    ].
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   172
    ^ nil
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   173
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   174
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   175
shortcutKeyCharacter:aKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   176
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   177
    "
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   178
    (aKey isNil and:[adornment isNil]) ifFalse:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   179
        self adornment shortcutKeyCharacter:aKey
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   180
    ]
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   181
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   182
794
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   183
startGroup
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   184
    "start group #left #right #center ... or nil
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   185
     at the moment only #right is implemented
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   186
    "
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   187
    ^ startGroup 
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   188
!
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   189
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   190
startGroup:aSymbol
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   191
    "start group #left #right #center ...
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   192
     at the moment only #right is implemented
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   193
    "
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   194
    (startGroup isNil or:[startGroup == #right]) ifTrue:[
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   195
        startGroup := aSymbol
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   196
    ] ifFalse:[
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   197
        self warn:('not supported group: ', aSymbol printString ).
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   198
    ]
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   199
!
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   200
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   201
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   202
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   203
        ^ adornment submenu
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   204
    ].
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   205
    ^ nil
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   206
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   207
    "Created: 25.2.1997 / 20:57:24 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   208
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   209
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   210
submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   211
    self adornment submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   212
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   213
    "Created: 25.2.1997 / 20:56:20 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   214
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   215
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   216
submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   217
    adornment notNil ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   218
        ^ adornment submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   219
    ].
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   220
    ^ nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   221
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   222
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   223
submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   224
    self adornment submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   225
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   226
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
    ^ value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    "Created: 25.2.1997 / 19:50:14 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
value:something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
    value := something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    "Created: 25.2.1997 / 19:11:13 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   239
!MenuItem methodsFor:'accessing behavior'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   240
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   241
beOff
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   242
    "set indication off
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   243
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   244
    self indication:false
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   245
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   246
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   247
beOn
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   248
    "set indication on
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   249
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   250
    self indication:true
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   251
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   252
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   253
disable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   254
    enabled := false
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   255
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   256
    "Created: 25.2.1997 / 19:39:09 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   257
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   258
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   259
enable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   260
    enabled := true
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   261
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   262
    "Created: 25.2.1997 / 19:39:00 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   263
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   264
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   265
enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   266
    "returns a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   267
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   268
    ^ enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   269
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   270
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   271
enabled:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   272
    "a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   273
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   274
    enabled := something
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   275
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   276
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   277
indication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   278
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   279
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   280
    adornment notNil ifTrue:[
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   281
        ^ adornment indication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   282
    ].
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   283
    ^ nil
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   284
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   285
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   286
indication:anIndication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   287
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   288
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   289
    (anIndication notNil or:[adornment notNil]) ifTrue:[
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   290
        self adornment indication:anIndication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   291
    ].
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   292
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   293
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   294
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   295
isButton
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   296
    "returns whether item looks like a Button
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
    ^isButton ? false
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   299
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   300
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   301
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   302
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   303
isButton:anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   304
    "sets whether item looks like a Button
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   305
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   306
    isButton := anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   307
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   308
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   309
!
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
translateLabel
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   312
    "returns whether label is translated
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   313
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   314
    ^translateLabel ? false
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   315
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
!
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   318
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   319
translateLabel:anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   320
    "sets whether label is translated
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   321
    "
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   322
    translateLabel := anBoolean
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   323
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   324
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   325
! !
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   326
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   327
!MenuItem methodsFor:'accessing resource'!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   328
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   329
findGuiResourcesIn:aResourceContainerOrApplication
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   330
    "setup a resource container
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   331
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   332
    |lblImg|
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   333
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   334
    self translateLabel ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   335
        label := ResourceRetriever findResourceLabel: label in: aResourceContainerOrApplication
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   336
    ].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   337
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   338
    adornment notNil ifTrue:[
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   339
        (lblImg := adornment labelImage) notNil ifTrue:[   
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   340
            lblImg findGuiResourcesIn:aResourceContainerOrApplication.
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   341
            lblImg labelText notNil ifTrue: [lblImg labelText: label].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   342
        ].   
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   343
        adornment submenu notNil ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   344
            adornment submenu findGuiResourcesIn:aResourceContainerOrApplication
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   345
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   346
    ]
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   347
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   348
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
!MenuItem methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
    2 to:aLiteralEncodedArray size by:2 do:[:i |
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
        |selector value|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
        selector := aLiteralEncodedArray at:i.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   358
        value    := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   359
        self perform:selector with:value
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
    ].
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
    "
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   363
     #( #MenuItem #rawLabel: 'left' #nameKey: 'identifier'  #value: #left )
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
         decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
    "
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
    "Modified: 25.2.1997 / 19:24:22 / cg"
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   368
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   369
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   370
literalArrayEncoding
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   371
    "return myself encoded as a literal array"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   372
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   373
    |coll something|
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   374
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   375
    coll := OrderedCollection new.
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   376
    coll add:#MenuItem.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   377
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   378
    label notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   379
        coll add:#label: ; add:(label literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   380
    ].
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   381
    self translateLabel ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   382
        coll add:#translateLabel: ; add:(translateLabel literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   383
    ].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   384
    self isButton ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   385
        coll add:#isButton:; add:(isButton literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   386
    ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   387
    nameKey notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   388
        coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   389
    ].
798
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   390
    isVisible notNil ifTrue:[
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   391
        isVisible ~~ true ifTrue:[
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   392
            coll add:#isVisible: ; add:(isVisible literalArrayEncoding)
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   393
        ]
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   394
    ].
794
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   395
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   396
    startGroup notNil ifTrue:[
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   397
        coll add:#startGroup: ; add:(startGroup literalArrayEncoding)
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   398
    ].
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   399
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   400
    value notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   401
        coll add:#value: ; add:(value literalArrayEncoding).
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   402
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   403
    activeHelpKey notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   404
        coll add:#activeHelpKey: ; add:(activeHelpKey literalArrayEncoding).
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   405
    ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   406
    (something := self enabled) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   407
        coll add:#enabled: ; add:(enabled literalArrayEncoding).
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   408
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   409
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   410
    adornment notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   411
        (something := self shortcutKeyCharacter) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   412
            coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   413
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   414
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   415
        (something := self accessCharacterPosition) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   416
            coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   417
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   418
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   419
        (something := self argument) notNil ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   420
            coll add:#argument: ; add:(something literalArrayEncoding)
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   421
        ].
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   422
661
c09ac6b9820d literalArrayEncoding
ca
parents: 653
diff changeset
   423
        adornment labelImage notNil ifTrue:[
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   424
            coll add:#labelImage: ; add:(adornment labelImage literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   425
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   426
        (something := self indication) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   427
            coll add:#indication: ; add:(something literalArrayEncoding)
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   428
        ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   429
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   430
        (something := self submenuChannel) notNil ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   431
            coll add:#submenuChannel: ; add:(something literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   432
        ].
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   433
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   434
        self hasSubmenu ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   435
            coll add:#submenu:; add:(self submenu literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   436
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   437
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   438
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   439
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   442
!MenuItem methodsFor:'private - accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   443
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   444
adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   445
    adornment isNil ifTrue:[
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   446
        adornment := MenuItemAdornment new
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   447
    ].
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   448
    ^ adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   449
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   450
    "Created: 25.2.1997 / 20:57:05 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   451
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   452
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   453
!MenuItem methodsFor:'queries'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   454
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   455
hasIndication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   456
    "test whether indication on/off exists
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   457
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   458
  ^ self indication notNil
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   459
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   460
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   461
hasSubmenu
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   462
    ^ self submenu notNil
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   463
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   464
    "Created: 25.2.1997 / 20:56:20 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   465
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   466
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   467
isEnabled
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   468
    ^ enabled value ? true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   469
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   470
    "Created: 25.2.1997 / 19:39:17 / cg"
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   471
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   472
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   473
isHidden
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   474
    "not yet supported"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   475
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   476
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   477
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   478
    "Created: / 27.10.1997 / 15:13:43 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   479
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   480
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   481
isOff
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   482
    "test whether indication on/off exists and is off
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   483
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   484
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   485
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   486
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   487
  ^ indication value == false
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   488
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   489
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   490
isOn
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   491
    "test whether indication on/off exists and is on
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   492
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   493
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   494
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   495
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   496
  ^ indication value == true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   497
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   498
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   499
!MenuItem::MenuItemAdornment methodsFor:'accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   500
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   501
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   502
    "return the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   503
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   504
    ^ accessCharacterPosition!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   505
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   506
accessCharacterPosition:something
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   507
    "set the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   508
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   509
    accessCharacterPosition := something.!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   510
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   511
argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   512
    "return the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   513
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   514
    ^ argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   515
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   516
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   517
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   518
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   519
argument:something
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   520
    "set the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   521
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   522
    argument := something.
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   523
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   524
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   525
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   526
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   527
color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   528
    "return the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   529
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   530
    ^ color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   531
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   532
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   533
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   534
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   535
color:something
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   536
    "set the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   537
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   538
    color := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   539
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   540
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   541
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   542
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   543
indication
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   544
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   545
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   546
    ^ indication
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   547
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   548
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   549
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   550
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   551
indication:something
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   552
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   553
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   554
    indication := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   555
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   556
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   557
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   558
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   559
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   560
    "return the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   561
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   562
    ^ labelImage!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   563
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   564
labelImage:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   565
    "set the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   566
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   567
    labelImage := something.!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   568
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   569
labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   570
    "get the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   571
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   572
    ^ labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   573
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   574
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   575
labelText:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   576
    "set the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   577
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   578
    labelText := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   579
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   580
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   581
shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   582
    "get the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   583
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   584
    ^ shortcutKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   585
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   586
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   587
shortcutKeyCharacter:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   588
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   589
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   590
    shortcutKey := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   591
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   592
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   593
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   594
    "get the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   595
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   596
    ^ submenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   597
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   598
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   599
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   600
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   601
submenu:something
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   602
    "set the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   603
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   604
    submenu := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   605
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   606
    "Created: 25.2.1997 / 20:59:28 / cg"
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   607
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   608
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   609
submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   610
    "get the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   611
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   612
    ^ submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   613
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   614
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   615
submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   616
    "set the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   617
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   618
    submenuChannel := something.
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   619
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   620
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
version
798
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   624
    ^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.20 1998-01-30 14:58:31 ca Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
! !