MenuItem.st
author ca
Tue, 27 May 1997 11:11:29 +0200
changeset 584 9a4c30f7586f
parent 581 0080d12b5758
child 590 fb2c55428c52
permissions -rw-r--r--
ST-80 compatible features addded
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
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
     2
	instanceVariableNames:'enabled label value nameKey adornment'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	category:'Views-Support'
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
Object subclass:#MenuItemAdornment
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
     9
	instanceVariableNames:'color indication submenu shortcutKey labelText labelImage
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    10
		accessCharacterPosition'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
	classVariableNames:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
	poolDictionaries:''
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
	privateIn:MenuItem
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
documentation
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    not yet finished MenuItem class - this will eventually replace
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
    most of the MenuView and PopUpMenu stuff.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    (and hopefully be ST-80 compatible ...)
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
    For now, only a subset of the full protocol is implemented.
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
    [author:]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
        Claus Gittinger
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
    [see also:]
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
        MenuItem
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
        PopUpMenu
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
"
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
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    36
!MenuItem class methodsFor:'instance creation'!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    37
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    38
labeled:aString
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    39
    ^ self new label:aString
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    40
! !
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
    41
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
!MenuItem methodsFor:'accessing'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    44
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    45
    "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
    46
    "
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    47
    adornment notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    48
        ^ adornment accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    49
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    50
    ^ nil
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
!
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:index
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    54
    "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
    55
    "
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    56
    (index isNil and:[adornment isNil]) ifFalse:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    57
        self adornment accessCharacterPosition:index
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
    58
    ]
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
580
5d407019526d add indication
ca
parents: 579
diff changeset
    61
indication
5d407019526d add indication
ca
parents: 579
diff changeset
    62
    "not yet supported
5d407019526d add indication
ca
parents: 579
diff changeset
    63
    "
5d407019526d add indication
ca
parents: 579
diff changeset
    64
    ^ true
5d407019526d add indication
ca
parents: 579
diff changeset
    65
!
5d407019526d add indication
ca
parents: 579
diff changeset
    66
5d407019526d add indication
ca
parents: 579
diff changeset
    67
indication:anIndication
5d407019526d add indication
ca
parents: 579
diff changeset
    68
    "not yet supported
5d407019526d add indication
ca
parents: 579
diff changeset
    69
    "
5d407019526d add indication
ca
parents: 579
diff changeset
    70
!
5d407019526d add indication
ca
parents: 579
diff changeset
    71
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    ^ label
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    "Created: 25.2.1997 / 19:48:16 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
453
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    78
label:aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    79
    label := aString
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    80
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    81
    "Created: 25.2.1997 / 19:55:16 / cg"
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    82
!
e06bf3866328 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 451
diff changeset
    83
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    84
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    85
    "gets the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    86
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    87
    adornment notNil ifTrue:[
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
    88
        ^ adornment labelImage value
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    89
    ].
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    90
  ^ nil
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    91
!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    92
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    93
labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    94
    "set the labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    95
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    96
    aResourceRetriever notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    97
        self adornment labelImage:aResourceRetriever
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    98
    ]
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
    99
!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   100
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   101
nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   102
    ^ nameKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   103
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   104
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   105
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   106
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   107
nameKey:aNameKey
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   108
    nameKey := aNameKey.
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   109
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   110
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   111
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   112
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   113
rawLabel
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   114
    ^ label
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   115
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   116
    "Created: 25.2.1997 / 19:48:16 / cg"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   117
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   118
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
rawLabel:aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    label := aString
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    "Created: 25.2.1997 / 19:11:02 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   125
shortcutKeyCharacter
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   126
    "ignored for now"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   127
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   128
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   129
        ^ adornment shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   130
    ].
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   131
    ^ nil
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   132
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   133
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   134
shortcutKeyCharacter:aKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   135
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   136
    "
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   137
    (aKey isNil and:[adornment isNil]) ifFalse:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   138
        self adornment shortcutKeyCharacter:aKey
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   139
    ]
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   140
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   141
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   142
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   143
    adornment notNil ifTrue:[
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   144
        ^ adornment submenu
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   145
    ].
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   146
    ^ nil
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   147
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   148
    "Created: 25.2.1997 / 20:57:24 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   149
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   150
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   151
submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   152
    self adornment submenu:aMenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   153
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   154
    "Created: 25.2.1997 / 20:56:20 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   155
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   156
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
    ^ value
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
    "Created: 25.2.1997 / 19:50:14 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
value:something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
    value := something
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
    "Created: 25.2.1997 / 19:11:13 / cg"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   169
!MenuItem methodsFor:'accessing behavior'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   170
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   171
disable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   172
    enabled := false
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   173
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   174
    "Created: 25.2.1997 / 19:39:09 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   175
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   176
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   177
enable
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   178
    enabled := true
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   179
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   180
    "Created: 25.2.1997 / 19:39:00 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   181
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   182
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   183
enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   184
    "returns a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   185
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   186
    ^ enabled
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   187
!
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   188
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   189
enabled:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   190
    "a boolean, valueHolder or block
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   191
    "
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   192
    enabled := something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   193
! !
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   194
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   195
!MenuItem methodsFor:'accessing resource'!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   196
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   197
findGuiResourcesIn:aResourceContainerOrApplication
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   198
    "setup a resource container
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   199
    "
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   200
    |lblImg|
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   201
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   202
    adornment notNil ifTrue:[
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   203
        (lblImg := adornment labelImage) notNil ifTrue:[
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   204
           lblImg findGuiResourcesIn:aResourceContainerOrApplication
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   205
        ]
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   206
    ]
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   207
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   208
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
!MenuItem methodsFor:'converting'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
fromLiteralArrayEncoding:aLiteralEncodedArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
    "read my contents from a aLiteralEncodedArray"
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
    2 to:aLiteralEncodedArray size by:2 do:[:i |
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
        |selector value|
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
        selector := aLiteralEncodedArray at:i.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   218
        value    := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   219
        self perform:selector with:value
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    ].
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    "
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   223
     #( #MenuItem #rawLabel: 'left' #nameKey: 'identifier'  #value: #left )
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
         decodeAsLiteralArray
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
    "
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
    "Modified: 25.2.1997 / 19:24:22 / cg"
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   228
!
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   229
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   230
literalArrayEncoding
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   231
    "return myself encoded as a literal array"
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   232
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   233
    |coll something|
490
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   234
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   235
    coll := OrderedCollection new.
ebe88e50b29a *** empty log message ***
ca
parents: 458
diff changeset
   236
    coll add:#MenuItem.
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   237
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   238
    label notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   239
        coll add:#label: ; add:(label literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   240
    ].
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   241
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   242
    nameKey notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   243
        coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   244
    ].
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   245
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   246
    (something := self enabled) ifFalse:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   247
        coll add:#enabled: ; add:(something literalArrayEncoding).
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   248
    ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   249
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   250
    value notNil ifTrue:[
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   251
        coll add:#value: ; add:(value literalArrayEncoding).
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   252
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   253
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   254
    (something := self shortcutKeyCharacter) notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   255
        coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   256
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   257
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   258
    (something := self accessCharacterPosition) notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   259
        coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   260
    ].
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   261
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   262
    (something := self labelImage) notNil ifTrue:[
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   263
        coll add:#labelImage: ; add:(something literalArrayEncoding)
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   264
    ].
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   265
  ^ coll asArray
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
! !
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   268
!MenuItem methodsFor:'private - accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   269
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   270
adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   271
    adornment isNil ifTrue:[
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   272
        adornment := MenuItemAdornment new
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   273
    ].
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   274
    ^ adornment
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   275
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   276
    "Created: 25.2.1997 / 20:57:05 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   277
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   278
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   279
!MenuItem methodsFor:'queries'!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   280
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   281
hasSubmenu
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   282
    ^ self submenu notNil
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   283
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   284
    "Created: 25.2.1997 / 20:56:20 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   285
!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   286
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   287
isEnabled
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   288
    ^ enabled value ? true
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   289
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   290
    "Created: 25.2.1997 / 19:39:17 / cg"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   291
! !
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   292
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   293
!MenuItem::MenuItemAdornment methodsFor:'accessing'!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   294
579
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   295
accessCharacterPosition
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   296
    "return the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   297
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   298
    ^ accessCharacterPosition!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   299
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   300
accessCharacterPosition:something
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   301
    "set the value of the instance variable 'accessCharacterPosition' (automatically generated)"
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   302
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   303
    accessCharacterPosition := something.!
77f6d490f1ac so far, so good
ca
parents: 578
diff changeset
   304
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   305
color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   306
    "return the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   307
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   308
    ^ color
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   309
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   310
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   311
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   312
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   313
color:something
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   314
    "set the value of the instance variable 'color' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   315
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   316
    color := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   317
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   318
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   319
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   320
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   321
indication
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   322
    "return the value of the instance variable 'indication' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   323
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   324
    ^ indication
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   325
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   326
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   327
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   328
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   329
indication:something
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   330
    "set the value of the instance variable 'indication' (automatically generated)"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   331
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   332
    indication := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   333
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   334
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   335
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   336
581
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   337
labelImage
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   338
    "return the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   339
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   340
    ^ labelImage!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   341
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   342
labelImage:something
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   343
    "set the value of the instance variable 'labelImage' (automatically generated)"
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   344
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   345
    labelImage := something.!
0080d12b5758 enabled can be something not only a boolean
ca
parents: 580
diff changeset
   346
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   347
labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   348
    "get the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   349
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   350
    ^ labelText
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   351
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   352
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   353
labelText:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   354
    "set the text appear as the menu label
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   355
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   356
    labelText := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   357
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   358
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   359
shortcutKeyCharacter
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   360
    "get the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   361
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   362
    ^ shortcutKey
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   363
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   364
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   365
shortcutKeyCharacter:something
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   366
    "set the  key to press to select the menu item from the keyboard
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   367
    "
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   368
    shortcutKey := something.
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   369
!
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   370
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   371
submenu
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   372
    "get the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   373
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   374
    ^ submenu
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   375
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   376
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   377
!
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   378
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   379
submenu:something
578
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   380
    "set the submenu or nil
7e0f62d9bc47 access methods ...
ca
parents: 490
diff changeset
   381
    "
458
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   382
    submenu := something.
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   383
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   384
    "Created: 25.2.1997 / 20:59:28 / cg"
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   385
! !
729ffdbd2b13 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 455
diff changeset
   386
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
!MenuItem class methodsFor:'documentation'!
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
version
584
9a4c30f7586f ST-80 compatible features addded
ca
parents: 581
diff changeset
   390
    ^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.10 1997-05-27 09:11:29 ca Exp $'
451
95064b26ded1 intitial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
! !