care for Text & images in rawLabel, when filtering.
Object subclass:#MenuItem
instanceVariableNames:'activeHelpKey enabled label value nameKey adornment
translateLabel isButton startGroup isVisible'
classVariableNames:''
poolDictionaries:''
category:'Views-Support'
!
Object subclass:#MenuItemAdornment
instanceVariableNames:'color indication submenu submenuChannel shortcutKey labelText
labelImage accessCharacterPosition argument'
classVariableNames:''
poolDictionaries:''
privateIn:MenuItem
!
!MenuItem class methodsFor:'documentation'!
documentation
"
not yet finished MenuItem class - this will eventually replace
most of the MenuView and PopUpMenu stuff.
(and hopefully be ST-80 compatible ...)
For now, only a subset of the full protocol is implemented.
[author:]
Claus Gittinger
[see also:]
MenuItem
PopUpMenu
"
! !
!MenuItem class methodsFor:'instance creation'!
labeled:aString
^ self new label:aString
! !
!MenuItem methodsFor:'ST-80 compatibility'!
isEnabled:aBoolean
self enabled:aBoolean
"Created: / 27.10.1997 / 16:34:55 / cg"
! !
!MenuItem methodsFor:'accessing'!
accessCharacterPosition
"get the index of the access character in the label text or string, or nil if none
"
adornment notNil ifTrue:[
^ adornment accessCharacterPosition
].
^ nil
!
accessCharacterPosition:index
"set the index of the access character in the label text or string, or nil if none
"
(index isNil and:[adornment isNil]) ifFalse:[
self adornment accessCharacterPosition:index
]
!
activeHelpKey
^ activeHelpKey
!
activeHelpKey:aKey
activeHelpKey := aKey
!
argument
"get argument given to the value (selector)
"
adornment notNil ifTrue:[
^ adornment argument
].
^ nil
!
argument:something
"set argument given to the value (selector)
"
|arg|
(arg := something) notNil ifTrue:[
arg isString ifTrue:[
(arg size == 0 or:[(arg indexOfNonSeparatorStartingAt:1) == 0]) ifTrue:[
arg := nil
]
]
].
(arg isNil and:[adornment isNil]) ifFalse:[
self adornment argument:arg
]
!
isVisible
^ isVisible ? true
!
isVisible:something
isVisible := something
!
label
^ self filteredLabel "/ label
"Created: / 25.2.1997 / 19:48:16 / cg"
"Modified: / 19.6.1998 / 00:02:55 / cg"
!
label:aString
label := aString
"Created: 25.2.1997 / 19:55:16 / cg"
!
labelImage
"gets the labelImage
"
adornment notNil ifTrue:[
^ adornment labelImage value
].
^ nil
!
labelImage:aResourceRetriever
"set the labelImage
"
aResourceRetriever notNil ifTrue:[
self adornment labelImage:aResourceRetriever
]
!
nameKey
^ nameKey
!
nameKey:aNameKey
nameKey := aNameKey.
!
rawLabel
^ label
"Created: 25.2.1997 / 19:48:16 / cg"
!
rawLabel:aString
label := aString
"Created: 25.2.1997 / 19:11:02 / cg"
!
shortcutKeyCharacter
"ignored for now"
adornment notNil ifTrue:[
^ adornment shortcutKeyCharacter
].
^ nil
!
shortcutKeyCharacter:aKey
"set the key to press to select the menu item from the keyboard
"
(aKey isNil and:[adornment isNil]) ifFalse:[
self adornment shortcutKeyCharacter:aKey
]
!
startGroup
"start group #left #right #center ... or nil
at the moment only #right is implemented
"
^ startGroup
!
startGroup:aSymbol
"start group #left #right #center ...
at the moment only #right is implemented
"
(startGroup isNil or:[startGroup == #right]) ifTrue:[
startGroup := aSymbol
] ifFalse:[
self warn:('not supported group: ', aSymbol printString ).
]
!
submenu
adornment notNil ifTrue:[
^ adornment submenu
].
^ nil
"Created: 25.2.1997 / 20:57:24 / cg"
!
submenu:aMenu
self adornment submenu:aMenu
"Created: 25.2.1997 / 20:56:20 / cg"
!
submenuChannel
adornment notNil ifTrue:[
^ adornment submenuChannel
].
^ nil
!
submenuChannel:something
self adornment submenuChannel:something
!
value
^ value
"Created: 25.2.1997 / 19:50:14 / cg"
!
value:something
value := something
"Created: 25.2.1997 / 19:11:13 / cg"
! !
!MenuItem methodsFor:'accessing behavior'!
beOff
"set indication off
"
self indication:false
!
beOn
"set indication on
"
self indication:true
!
disable
enabled := false
"Created: 25.2.1997 / 19:39:09 / cg"
!
enable
enabled := true
"Created: 25.2.1997 / 19:39:00 / cg"
!
enabled
"returns a boolean, valueHolder or block
"
^ enabled
!
enabled:something
"a boolean, valueHolder or block
"
enabled := something
!
indication
"test whether the menu item has an on/off indicator (CheckToggle)
"
adornment notNil ifTrue:[
^ adornment indication
].
^ nil
!
indication:anIndication
"test whether the menu item has an on/off indicator (CheckToggle)
"
(anIndication notNil or:[adornment notNil]) ifTrue:[
self adornment indication:anIndication.
].
!
isButton
"returns whether item looks like a Button
"
^isButton ? false
!
isButton:anBoolean
"sets whether item looks like a Button
"
isButton := anBoolean
!
translateLabel
"returns whether label is translated
"
^translateLabel ? false
!
translateLabel:anBoolean
"sets whether label is translated
"
translateLabel := anBoolean
! !
!MenuItem methodsFor:'accessing resource'!
findGuiResourcesIn:aResourceContainerOrApplication
"setup a resource container
"
|lblImg m|
self translateLabel ifTrue:[
label := ResourceRetriever findResourceLabel: label in: aResourceContainerOrApplication
].
adornment notNil ifTrue:[
(lblImg := adornment labelImage) notNil ifTrue:[
lblImg findGuiResourcesIn:aResourceContainerOrApplication.
lblImg labelText notNil ifTrue: [lblImg labelText: label].
].
(m := adornment submenu) notNil ifTrue:[
m := m value.
m notNil ifTrue:[
m findGuiResourcesIn:aResourceContainerOrApplication
]
].
]
"Modified: / 18.6.1998 / 16:54:25 / cg"
! !
!MenuItem methodsFor:'converting'!
fromLiteralArrayEncoding:aLiteralEncodedArray
"read my contents from a aLiteralEncodedArray"
2 to:aLiteralEncodedArray size by:2 do:[:i |
|selector value|
selector := aLiteralEncodedArray at:i.
value := (aLiteralEncodedArray at:i+1) decodeAsLiteralArray.
self perform:selector with:value
].
"
#( #MenuItem #rawLabel: 'left' #nameKey: 'identifier' #value: #left )
decodeAsLiteralArray
"
"Modified: 25.2.1997 / 19:24:22 / cg"
!
literalArrayEncoding
"return myself encoded as a literal array"
|coll something|
coll := OrderedCollection new.
coll add:#MenuItem.
label notNil ifTrue:[
coll add:#label: ; add:(label literalArrayEncoding)
].
self translateLabel ifTrue:[
coll add:#translateLabel: ; add:(translateLabel literalArrayEncoding)
].
self isButton ifTrue:[
coll add:#isButton:; add:(isButton literalArrayEncoding)
].
nameKey notNil ifTrue:[
coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
].
isVisible notNil ifTrue:[
isVisible ~~ true ifTrue:[
coll add:#isVisible: ; add:(isVisible literalArrayEncoding)
]
].
startGroup notNil ifTrue:[
coll add:#startGroup: ; add:(startGroup literalArrayEncoding)
].
value notNil ifTrue:[
coll add:#value: ; add:(value literalArrayEncoding).
].
activeHelpKey notNil ifTrue:[
coll add:#activeHelpKey: ; add:(activeHelpKey literalArrayEncoding).
].
(something := self enabled) notNil ifTrue:[
coll add:#enabled: ; add:(enabled literalArrayEncoding).
].
adornment notNil ifTrue:[
(something := self shortcutKeyCharacter) notNil ifTrue:[
coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
].
(something := self accessCharacterPosition) notNil ifTrue:[
coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
].
(something := self argument) notNil ifTrue:[
coll add:#argument: ; add:(something literalArrayEncoding)
].
adornment labelImage notNil ifTrue:[
coll add:#labelImage: ; add:(adornment labelImage literalArrayEncoding)
].
(something := self indication) notNil ifTrue:[
coll add:#indication: ; add:(something literalArrayEncoding)
].
(something := self submenuChannel) notNil ifTrue:[
coll add:#submenuChannel: ; add:(something literalArrayEncoding)
].
self hasSubmenu ifTrue:[
coll add:#submenu:; add:(self submenu literalArrayEncoding)
].
].
^ coll asArray
! !
!MenuItem methodsFor:'private - accessing'!
adornment
adornment isNil ifTrue:[
adornment := MenuItemAdornment new
].
^ adornment
"Created: 25.2.1997 / 20:57:05 / cg"
!
filteredLabel
"return the label without any &-chars"
|rawLabel l in out c pos emp e|
rawLabel := self rawLabel.
rawLabel isString ifFalse:[^ rawLabel].
"/ be careful to preserve any emphasis ...
"/ bad kludge ...
rawLabel isText ifTrue:[
emp := RunArray new.
].
out := WriteStream on:''.
in := rawLabel readStream.
[in atEnd] whileFalse:[
emp notNil ifTrue:[
e := rawLabel emphasisAt:(in position).
].
c := in next.
c == $& ifTrue:[
in peek == $& ifTrue:[
out nextPut:c.
emp notNil ifTrue:[
emp add:e
]
]
] ifFalse:[
out nextPut:c.
emp notNil ifTrue:[
emp add:e
]
]
].
l := out contents.
emp notNil ifTrue:[
^ Text string:l emphasisCollection:emp
].
^ l.
"Created: / 19.6.1998 / 00:02:10 / cg"
"Modified: / 20.6.1998 / 17:15:18 / cg"
! !
!MenuItem methodsFor:'queries'!
hasIndication
"test whether indication on/off exists
"
^ self indication notNil
!
hasSubmenu
^ self submenu notNil
"Created: 25.2.1997 / 20:56:20 / cg"
!
isEnabled
^ enabled value ? true
"Created: 25.2.1997 / 19:39:17 / cg"
!
isHidden
"not yet supported"
^ false
"Created: / 27.10.1997 / 15:13:43 / cg"
!
isOff
"test whether indication on/off exists and is off
"
|indication|
indication := self indication.
^ indication value == false
!
isOn
"test whether indication on/off exists and is on
"
|indication|
indication := self indication.
^ indication value == true
! !
!MenuItem::MenuItemAdornment methodsFor:'accessing'!
accessCharacterPosition
"return the value of the instance variable 'accessCharacterPosition' (automatically generated)"
^ accessCharacterPosition!
accessCharacterPosition:something
"set the value of the instance variable 'accessCharacterPosition' (automatically generated)"
accessCharacterPosition := something.!
argument
"return the value of the instance variable 'argument' (automatically generated)"
^ argument
"Created: 25.2.1997 / 20:59:28 / cg"
!
argument:something
"set the value of the instance variable 'argument' (automatically generated)"
argument := something.
"Created: 25.2.1997 / 20:59:28 / cg"
!
color
"return the value of the instance variable 'color' (automatically generated)"
^ color
"Created: 25.2.1997 / 20:59:28 / cg"
!
color:something
"set the value of the instance variable 'color' (automatically generated)"
color := something.
"Created: 25.2.1997 / 20:59:28 / cg"
!
indication
"test whether the menu item has an on/off indicator (CheckToggle)
"
^ indication
"Created: 25.2.1997 / 20:59:28 / cg"
!
indication:something
"test whether the menu item has an on/off indicator (CheckToggle)
"
indication := something.
"Created: 25.2.1997 / 20:59:28 / cg"
!
labelImage
"return the value of the instance variable 'labelImage' (automatically generated)"
^ labelImage!
labelImage:something
"set the value of the instance variable 'labelImage' (automatically generated)"
labelImage := something.!
labelText
"get the text appear as the menu label
"
^ labelText
!
labelText:something
"set the text appear as the menu label
"
labelText := something.
!
shortcutKeyCharacter
"get the key to press to select the menu item from the keyboard
"
^ shortcutKey
!
shortcutKeyCharacter:something
"set the key to press to select the menu item from the keyboard
"
shortcutKey := something.
!
submenu
"get the submenu or nil
"
^ submenu value
"Created: / 25.2.1997 / 20:59:28 / cg"
"Modified: / 19.6.1998 / 00:33:58 / cg"
!
submenu:something
"set the submenu or nil
"
submenu := something.
"Created: 25.2.1997 / 20:59:28 / cg"
!
submenuChannel
"get the submenuChannel or nil
"
^ submenuChannel
!
submenuChannel:something
"set the submenuChannel or nil
"
submenuChannel := something.
!
submenuHolder
"get the submenuHolder or nil
"
^ submenu
"Modified: / 19.6.1998 / 00:33:58 / cg"
"Created: / 19.6.1998 / 00:34:32 / cg"
! !
!MenuItem class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.23 1998-06-20 15:15:59 cg Exp $'
! !