MenuItem.st
author Claus Gittinger <cg@exept.de>
Thu, 18 Jun 1998 16:54:43 +0200
changeset 960 fee5a1a50374
parent 798 8a27a879ff23
child 973 cd6b8d08c9c9
permissions -rw-r--r--
adornments submenu may be a valueHolder.
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
    "
960
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   332
    |lblImg m|
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
        ].   
960
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   343
        (m := adornment submenu) notNil ifTrue:[
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   344
            m := m value.
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   345
            m notNil ifTrue:[
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   346
                m findGuiResourcesIn:aResourceContainerOrApplication
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   347
            ]
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   348
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   349
    ]
960
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   350
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   351
    "Modified: / 18.6.1998 / 16:54:25 / cg"
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   352
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   353
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
!MenuItem methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   358
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
    2 to:aLiteralEncodedArray size by:2 do:[:i |
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
        |selector value|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
        selector := aLiteralEncodedArray at:i.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   363
        value    := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   364
        self perform:selector with:value
451
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
    "
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   368
     #( #MenuItem #rawLabel: 'left' #nameKey: 'identifier'  #value: #left )
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   369
         decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   370
    "
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   371
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
    "Modified: 25.2.1997 / 19:24:22 / cg"
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   373
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   374
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   375
literalArrayEncoding
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   376
    "return myself encoded as a literal array"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   377
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   378
    |coll something|
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   379
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   380
    coll := OrderedCollection new.
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   381
    coll add:#MenuItem.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   382
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   383
    label notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   384
        coll add:#label: ; add:(label literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   385
    ].
752
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   386
    self translateLabel ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   387
        coll add:#translateLabel: ; add:(translateLabel literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   388
    ].
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   389
    self isButton ifTrue:[
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   390
        coll add:#isButton:; add:(isButton literalArrayEncoding)
93690dcd1b75 button and label translation support added.
tz
parents: 724
diff changeset
   391
    ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   392
    nameKey notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   393
        coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   394
    ].
798
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   395
    isVisible notNil ifTrue:[
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   396
        isVisible ~~ true ifTrue:[
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   397
            coll add:#isVisible: ; add:(isVisible literalArrayEncoding)
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   398
        ]
8a27a879ff23 support of visible/invisible items
ca
parents: 794
diff changeset
   399
    ].
794
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   400
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   401
    startGroup notNil ifTrue:[
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   402
        coll add:#startGroup: ; add:(startGroup literalArrayEncoding)
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   403
    ].
432935e754e0 add new feature:
ca
parents: 752
diff changeset
   404
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   405
    value notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   406
        coll add:#value: ; add:(value literalArrayEncoding).
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   407
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   408
    activeHelpKey notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   409
        coll add:#activeHelpKey: ; add:(activeHelpKey literalArrayEncoding).
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   410
    ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   411
    (something := self enabled) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   412
        coll add:#enabled: ; add:(enabled literalArrayEncoding).
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   413
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   414
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   415
    adornment notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   416
        (something := self shortcutKeyCharacter) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   417
            coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   418
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   419
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   420
        (something := self accessCharacterPosition) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   421
            coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   422
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   423
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   424
        (something := self argument) notNil ifTrue:[
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   425
            coll add:#argument: ; add:(something literalArrayEncoding)
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   426
        ].
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   427
661
c09ac6b9820d literalArrayEncoding
ca
parents: 653
diff changeset
   428
        adornment labelImage notNil ifTrue:[
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   429
            coll add:#labelImage: ; add:(adornment labelImage literalArrayEncoding)
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   430
        ].
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   431
        (something := self indication) notNil ifTrue:[
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   432
            coll add:#indication: ; add:(something literalArrayEncoding)
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   433
        ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   434
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   435
        (something := self submenuChannel) notNil ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   436
            coll add:#submenuChannel: ; add:(something literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   437
        ].
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   438
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   439
        self hasSubmenu ifTrue:[
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   440
            coll add:#submenu:; add:(self submenu literalArrayEncoding)
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   441
        ].
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   442
    ].
653
1e7c30f9ca6c literalArrayEncoding updated
ca
parents: 640
diff changeset
   443
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   444
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   447
!MenuItem methodsFor:'private - accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   448
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   449
adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   450
    adornment isNil ifTrue:[
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   451
        adornment := MenuItemAdornment new
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   452
    ].
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   453
    ^ adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   454
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   455
    "Created: 25.2.1997 / 20:57:05 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   456
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   457
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   458
!MenuItem methodsFor:'queries'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   459
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   460
hasIndication
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   461
    "test whether indication on/off exists
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   462
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   463
  ^ self indication notNil
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   464
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   465
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   466
hasSubmenu
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   467
    ^ self submenu notNil
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   468
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   469
    "Created: 25.2.1997 / 20:56:20 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   470
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   471
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   472
isEnabled
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   473
    ^ enabled value ? true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   474
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   475
    "Created: 25.2.1997 / 19:39:17 / cg"
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   476
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   477
724
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   478
isHidden
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   479
    "not yet supported"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   480
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   481
    ^ false
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   482
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   483
    "Created: / 27.10.1997 / 15:13:43 / cg"
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   484
!
898519684261 more VW comaptibility
Claus Gittinger <cg@exept.de>
parents: 684
diff changeset
   485
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   486
isOff
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   487
    "test whether indication on/off exists and is off
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   488
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   489
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   490
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   491
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   492
  ^ indication value == false
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   493
!
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   494
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   495
isOn
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   496
    "test whether indication on/off exists and is on
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   497
    "
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   498
    |indication|
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   499
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   500
    indication := self indication.
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   501
  ^ indication value == true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   502
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   503
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   504
!MenuItem::MenuItemAdornment methodsFor:'accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   505
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   506
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   507
    "return 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!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   510
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   511
accessCharacterPosition:something
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   512
    "set the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   513
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   514
    accessCharacterPosition := something.!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   515
684
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   516
argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   517
    "return the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   518
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   519
    ^ argument
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   520
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   521
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   522
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   523
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   524
argument:something
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   525
    "set the value of the instance variable 'argument' (automatically generated)"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   526
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   527
    argument := something.
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   528
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   529
    "Created: 25.2.1997 / 20:59:28 / cg"
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   530
!
184dd159d02e support of arguments
ca
parents: 666
diff changeset
   531
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   532
color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   533
    "return the value of the instance variable 'color' (automatically generated)"
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
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   536
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   537
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   538
!
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
color:something
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   541
    "set the value of the instance variable 'color' (automatically generated)"
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
    color := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   544
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   545
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   546
!
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
indication
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   549
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   550
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   551
    ^ indication
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   552
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   553
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   554
!
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
indication:something
590
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   557
    "test whether the menu item has an on/off indicator (CheckToggle)
fb2c55428c52 ST-80 compatibility
ca
parents: 584
diff changeset
   558
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   559
    indication := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   560
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   561
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   562
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   563
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   564
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   565
    "return 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!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   568
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   569
labelImage:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   570
    "set the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   571
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   572
    labelImage := something.!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   573
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   574
labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   575
    "get the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   576
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   577
    ^ labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   578
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   579
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   580
labelText:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   581
    "set the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   582
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   583
    labelText := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   584
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   585
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   586
shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   587
    "get the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   588
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   589
    ^ shortcutKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   590
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   591
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   592
shortcutKeyCharacter:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   593
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   594
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   595
    shortcutKey := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   596
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   597
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   598
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   599
    "get the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   600
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   601
    ^ submenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   602
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   603
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   604
!
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
submenu:something
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   607
    "set the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   608
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   609
    submenu := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   610
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   611
    "Created: 25.2.1997 / 20:59:28 / cg"
666
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   612
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   613
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   614
submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   615
    "get the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   616
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   617
    ^ submenuChannel
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   618
!
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   619
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   620
submenuChannel:something
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   621
    "set the submenuChannel or nil
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   622
    "
6e614a5d9248 add submenuChannel
ca
parents: 661
diff changeset
   623
    submenuChannel := something.
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   624
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   625
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
version
960
fee5a1a50374 adornments submenu may be a valueHolder.
Claus Gittinger <cg@exept.de>
parents: 798
diff changeset
   629
    ^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.21 1998-06-18 14:54:43 cg Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
! !