got rid of adornment; ResourceRetriever code cleaned up.
"
COPYRIGHT (c) 1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libview2' }"
Object subclass:#MenuItem
instanceVariableNames:'activeHelpKey enabled label itemValue value nameKey
translateLabel isButton startGroup isVisible hideMenuOnActivated
triggerOnDown delayMenu indication submenu submenuChannel
shortcutKey labelImage accessCharacterPosition argument choice
choiceValue font auxValue showBusyCursorWhilePerforming
keepLinkedMenu horizontalLayout'
classVariableNames:''
poolDictionaries:''
category:'Views-Support'
!
!MenuItem class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1998 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
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'!
label:aString
"create and return a new menuItem, given a label string"
^ self new label:aString
"Modified: / 4.8.1998 / 17:33:13 / cg"
"Created: / 14.8.1998 / 19:19:14 / cg"
!
label:labelString value:selectorOrValue
"create and return a new menuItem, given its label and value"
^ (self new) label:labelString; value:selectorOrValue; yourself
"Created: / 4.8.1998 / 17:34:18 / cg"
!
labeled:aString
"create and return a new menuItem, given a label string"
^ self new label:aString
"Modified: / 4.8.1998 / 17:33:13 / cg"
!
separator
"create and return a new menuItem for a separator"
^ self label:'-'
! !
!MenuItem methodsFor:'Compatibility - ST80'!
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
"
^ accessCharacterPosition
!
accessCharacterPosition:index
"set the index of the access character in the label text or string, or nil if none
"
accessCharacterPosition := index
!
activeHelpKey
^ activeHelpKey
!
activeHelpKey:aKey
activeHelpKey := aKey
!
argument
"get argument given to the value (selector)
"
^ argument
!
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
]
]
].
argument := arg
!
auxValue
"an additional, arbitrary value"
^ auxValue
!
auxValue:something
"set the auxValue - an arbitrary user value
"
auxValue := something
!
choice:something
"set the value of the instance variable 'choice' (automatically generated)"
choice := something.
"Created: / 14.8.1998 / 14:32:06 / cg"
!
choiceValue
"return the value of the instance variable 'choiceValue' (automatically generated)"
^ choiceValue
"Created: / 14.8.1998 / 15:39:26 / cg"
!
choiceValue:something
"set the value of the instance variable 'choiceValue' (automatically generated)"
choiceValue := something.
"Created: / 14.8.1998 / 15:39:26 / cg"
!
font
"get the specific font for an item or nil
"
^ font
!
font:aFont
"set a specific font for an item
"
font := aFont.
!
horizontalLayout
"on default submenus has a vertical layout;
true, the submenu has a horizontal layout.
"
^ horizontalLayout
!
horizontalLayout:aBoolean
"on default submenus has a vertical layout;
true, the submenu has a horizontal layout.
"
horizontalLayout := aBoolean.
!
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"
!
isVisible
^ isVisible ? true
!
isVisible:something
isVisible := something
!
itemValue
^ itemValue
"Created: 25.2.1997 / 19:50:14 / cg"
!
itemValue:something
itemValue := something
"Created: 25.2.1997 / 19:11:13 / cg"
!
keepLinkedMenu
"return the value of the instance variable 'keepLinkedMenu' (automatically generated)"
^ keepLinkedMenu ? false
!
keepLinkedMenu:aBoolean
"set the value of the instance variable 'keepLinkedMenu' (automatically generated)"
keepLinkedMenu := aBoolean ? false.
!
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.
!
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"
!
resourceRetriever
|retriever|
retriever := labelImage.
(retriever notNil and:[retriever isKindOf:ResourceRetriever]) ifTrue:[
^ retriever
].
^ nil
!
resourceRetriever:aRetriever
self labelImage:aRetriever
!
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.
!
showBusyCursorWhilePerforming
"get the flag which controls if a busy cursor is to be shown
while performing the menu action. Defaults to false."
^ showBusyCursorWhilePerforming ? false
!
showBusyCursorWhilePerforming:aBoolean
"set/clear the flag which controls if a busy cursor is to be shown
while performing the menu action. Defaults to false."
showBusyCursorWhilePerforming := aBoolean
!
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
"
(something isValueModel or:[something isBlock]) ifTrue:[
submenuChannel notNil ifTrue:[
"/ programmers error ?
"/ how can I decide which one to use if there is both
"/ a channel and a subMenu ...
self halt:'overwriting submenuchannel'.
].
submenuChannel := something
] ifFalse:[
submenu := something.
]
"Created: / 25.2.1997 / 20:59:28 / cg"
"Modified: / 5.2.2000 / 16:53:28 / cg"
!
submenuChannel
"get the submenuChannel or nil
"
^ submenuChannel
!
submenuChannel:something
"set the submenuChannel or nil
"
submenuChannel := something.
!
value
self halt.
^ itemValue
"Created: 25.2.1997 / 19:50:14 / cg"
!
value:something
itemValue := 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
!
choice
"return the menu items choice indicator (RadioButton)
"
^ choice
"Created: / 14.8.1998 / 14:34:55 / cg"
"Modified: / 14.8.1998 / 15:11:57 / cg"
!
delayMenu
"return true, the menu is shown delayed, if the button is still pressed after a while.
Only useful with buttons in non-popup-menus
"
^ delayMenu ? false
!
delayMenu:aBoolean
"if true, the menu is shown delayed, if the button is still pressed after a while.
Only useful with buttons in non-popup-menus
"
delayMenu := aBoolean
!
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
!
hideMenuOnActivated
"hide the menu when the item was activated; the default is true
"
^ hideMenuOnActivated ? true
!
hideMenuOnActivated:aBool
"hide the menu when the item was activated; the default is true
"
hideMenuOnActivated := aBool ? true
!
translateLabel
"returns whether label is translated
"
^translateLabel ? false
!
translateLabel:anBoolean
"sets whether label is translated
"
translateLabel := anBoolean
!
triggerOnDown
"trigger the action if pressed
"
^ triggerOnDown ? false
!
triggerOnDown:aBool
"trigger the action if pressed
"
triggerOnDown := aBool.
! !
!MenuItem methodsFor:'accessing-look'!
icon:anImage
self resourceRetriever: (ResourceRetriever icon:anImage)
!
isButton
"returns whether item looks like a Button
"
^isButton ? false
!
isButton:anBoolean
"sets whether item looks like a Button
"
isButton := anBoolean
!
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"
!
label:aString icon:anImage
self label:aString.
self resourceRetriever: (ResourceRetriever icon:anImage string:'')
!
startGroup
"start group #left #right #center ... or nil
at the moment only #right is implemented
"
^ startGroup ? #left
!
startGroup:aSymbol
"start group #left #right #center ...
at the moment only #right is implemented
"
(#(nil #left #right) includes:startGroup) ifTrue:[
startGroup := aSymbol
] ifFalse:[
self warn:('unsupported group: ', aSymbol printString ).
startGroup := #left
]
! !
!MenuItem methodsFor:'accessing-resource'!
findGuiResourcesIn:aResourceContainerOrApplication
"setup a resource container
"
^ self findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:nil
!
findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:aValueHolderOrNil
"setup a resource container
"
|retriever m|
self translateLabel ifTrue:[
label := ResourceRetriever
findResourceLabel:label
in:aResourceContainerOrApplication
rememberResourcesIn:aValueHolderOrNil
].
(retriever := self resourceRetriever) notNil ifTrue:[
retriever findGuiResourcesIn:aResourceContainerOrApplication.
retriever labelText notNil ifTrue: [retriever labelText: label].
].
(m := self submenu) notNil ifTrue:[
m := m value.
m notNil ifTrue:[
m findGuiResourcesIn:aResourceContainerOrApplication rememberResourcesIn:aValueHolderOrNil
]
]
"Modified: / 18.6.1998 / 16:54:25 / cg"
! !
!MenuItem methodsFor:'converting'!
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:true
].
self isButton ifTrue:[
coll add:#isButton:; add:true
].
triggerOnDown == true ifTrue:[
coll add:#triggerOnDown: ; add:triggerOnDown
].
hideMenuOnActivated == false ifTrue:[
coll add:#hideMenuOnActivated: ; add:hideMenuOnActivated
].
nameKey notNil ifTrue:[
coll add:#nameKey: ; add:(nameKey literalArrayEncoding)
].
isVisible notNil ifTrue:[
isVisible ~~ true ifTrue:[
coll add:#isVisible: ; add:(isVisible literalArrayEncoding)
]
].
(startGroup notNil and:[startGroup ~~ #left]) 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).
].
(something := self shortcutKeyCharacter) notNil ifTrue:[
coll add:#shortcutKeyCharacter: ; add:(something literalArrayEncoding)
].
(something := self font) notNil ifTrue:[
coll add:#font: ; add:(something literalArrayEncoding)
].
(something := self accessCharacterPosition) notNil ifTrue:[
coll add:#accessCharacterPosition: ; add:(something literalArrayEncoding)
].
(something := self horizontalLayout) == true ifTrue:[
coll add:#horizontalLayout: ; add:(something literalArrayEncoding)
].
(something := self showBusyCursorWhilePerforming) == true ifTrue:[
coll add:#showBusyCursorWhilePerforming: ; add:(something literalArrayEncoding)
].
(something := self argument) notNil ifTrue:[
"/ coll add:#argument: ; add:(something literalArrayEncoding) -- cg: wrong - see decoder part.
something class == Array ifTrue:[
coll add:#argument: ; add:(something collect:[:each | each literalArrayEncoding]).
] ifFalse:[
coll add:#argument: ; add:(something literalArrayEncoding)
]
].
(something := self resourceRetriever) notNil ifTrue:[
"/ ParcPlace stores the ResourceRetriever under the labelImage key.
coll add:#resourceRetriever: ; add:(something literalArrayEncoding)
].
(something := self indication) notNil ifTrue:[
coll add:#indication: ; add:(something literalArrayEncoding)
].
(something := self choice) notNil ifTrue:[
coll add:#choice: ; add:(something literalArrayEncoding).
(something := self choiceValue) notNil ifTrue:[
coll add:#choiceValue: ; add:(something literalArrayEncoding)
].
].
(something := self auxValue) notNil ifTrue:[
coll add:#auxValue: ; add:(something literalArrayEncoding)
].
(something := self submenuChannel) notNil ifTrue:[
coll add:#submenuChannel: ; add:(something literalArrayEncoding).
(something := self keepLinkedMenu) ifTrue:[
coll add:#keepLinkedMenu: ; add:true
]
].
self hasSubmenu ifTrue:[
coll add:#submenu:; add:(self submenu literalArrayEncoding)
].
^ coll asArray
"Modified: / 14.8.1998 / 15:44:53 / cg"
! !
!MenuItem methodsFor:'encoding & decoding'!
fromLiteralArrayEncoding:aLiteralEncodedArray
"read my contents from a aLiteralEncodedArray"
|selector value|
2 to:aLiteralEncodedArray size by:2 do:[:i |
selector := aLiteralEncodedArray at:i.
value := (aLiteralEncodedArray at:i+1).
selector == #argument: ifFalse:[
value := value decodeAsLiteralArray
].
self perform:selector with:value
].
"
#( #MenuItem #rawLabel: 'left' #nameKey: 'identifier' #value: #left )
decodeAsLiteralArray
"
"Modified: / 4.2.2000 / 12:50:28 / cg"
! !
!MenuItem methodsFor:'printing & storing'!
displayString
^ self classNameWithArticle , '(' , label storeString , ')'
! !
!MenuItem methodsFor:'private - accessing'!
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'!
hasChoice
"test whether choice exists
"
^ self choice notNil
"Created: / 14.8.1998 / 14:34:29 / cg"
!
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 class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libview2/MenuItem.st,v 1.51 2002-10-24 15:31:36 cg Exp $'
! !