"
COPYRIGHT (c) 1997 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.
"
SimpleView subclass:#MenuPanel
instanceVariableNames:'adornment shadowView mapTime mustRearrange superMenu
shortKeyInset selection items groupSizes receiver enableChannel
menuHolder enabled onLevel offLevel fgColor activeFgColor
lastActiveMenu activeBgColor disabledFgColor groupDividerSize
itemSpace fitFirstPanel rightArrow rightArrowShadow'
classVariableNames:'InitialSelectionQuerySignal DefaultAdornment
DefaultGroupDividerSize DefaultHilightLevel DefaultLevel
DefaultItemSpace DefaultForegroundColor DefaultBackgroundColor
DefaultHilightForegroundColor DefaultHilightBackgroundColor
DefaultDisabledForegroundColor DefaultFitFirstPanel
RightArrowForm RightArrowShadowForm'
poolDictionaries:''
category:'Views-Menus'
!
Object subclass:#Item
instanceVariableNames:'layout menuPanel subMenu adornment rawLabel enableChannel nameKey
accessCharacterPosition value label activeHelpKey submenuChannel
disabledImage isButton'
classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
VerticalButtonInset LabelRightOffset ShortcutKeyOffset
IndicatorOn IndicatorOff'
poolDictionaries:''
privateIn:MenuPanel
!
Object subclass:#Adornment
instanceVariableNames:'indication accessCharacterPosition shortcutKey argument'
classVariableNames:''
poolDictionaries:''
privateIn:MenuPanel::Item
!
!MenuPanel class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1997 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
"
a menu panel used for both pull-down-menus and pop-up-menus.
not yet finished MenuPanel class - this will eventually replace
most of the MenuView and PopUpMenu stuff.
(and hopefully be ST-80 compatible ...)
To create a menu, there exists a MenuEditor which will generate
a menu specification.
[author:]
Claus Atzkern
[see also:]
Menu
MenuItem
MenuEditor
"
!
examples
"
start as PullDownMenu
[exBegin]
|top subView mview desc s1 s2 s3 img lbs labels|
top := StandardSystemView new.
mview := MenuPanel in:top.
labels := #( 'foo' 'bar' 'baz' 'test' 'claus' ).
mview level:2.
mview verticalLayout:false.
img := Image fromFile:'bitmaps/SBrowser.xbm'.
lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test' with:'ludwig'.
mview labels:lbs.
mview shortcutKeyAt:2 put:#Cut.
mview accessCharacterPositionAt:1 put:1.
mview accessCharacterPositionAt:2 put:2.
mview enabledAt:5 put:false.
mview groupSizes:#( 2 2 ).
s1 := MenuPanel labels:labels.
s1 accessCharacterPositionAt:1 put:1.
s1 accessCharacterPositionAt:2 put:2.
s1 groupSizes:#( 2 2 ).
s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).
s3 := MenuPanel labels:lbs.
s1 subMenuAt:2 put:s2.
s1 subMenuAt:3 put:(MenuPanel labels:lbs).
s2 subMenuAt:3 put:s3.
s3 subMenuAt:3 put:(MenuPanel labels:labels).
s3 shortcutKeyAt:3 put:$q.
mview subMenuAt:1 put:s1.
mview subMenuAt:4 put:(MenuPanel labels:lbs).
(mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.
s1 shortcutKeyAt:1 put:#Copy.
s1 shortcutKeyAt:3 put:#Paste.
mview subMenuAt:2 put:(MenuPanel labels:labels).
top extent:(mview preferredExtent).
top open.
[exEnd]
start as PopUpMenu
[exBegin]
|subView mview desc s1 s2 s3 img lbs labels|
mview := MenuPanel new.
labels := #( 'foo' 'bar' 'baz' ).
mview level:2.
img := Image fromFile:'bitmaps/SBrowser.xbm'.
lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test'.
mview labels:lbs.
s1 := MenuPanel labels:labels.
s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).
s3 := MenuPanel labels:lbs.
s1 subMenuAt:2 put:s2.
s1 subMenuAt:3 put:(MenuPanel labels:lbs).
s2 subMenuAt:3 put:s3.
s3 subMenuAt:3 put:(MenuPanel labels:labels).
s3 shortcutKeyAt:3 put:$q.
mview subMenuAt:1 put:s1.
mview subMenuAt:4 put:(MenuPanel labels:lbs).
(mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.
s1 shortcutKeyAt:1 put:#Copy.
s1 shortcutKeyAt:3 put:#Paste.
mview subMenuAt:2 put:(MenuPanel labels:labels).
mview startUp
[exEnd]
start from menu spec
[exBegin]
|menu|
menu := MenuPanel menu:
#(#Menu #( #(#MenuItem
#label: 'File'
#submenu:
#(#Menu #(#(#MenuItem #label: 'quit' #value:#quit )
(#MenuItem
#label: 'edit'
#submenu:
#(#Menu #( #(#MenuItem #label: 'edit' #value:#edit )
#(#MenuItem #label: 'close' #value:#close)
)
nil
nil
)
)
#(#MenuItem #label: 'help' #value:#help )
)
nil
nil
)
)
#(#MenuItem #label: 'Inspect' #value:#inspectMenu )
#(#MenuItem #label: 'Bar'
#submenu:
#(#Menu #( #(#MenuItem #label: 'bar 1' #value:#bar1 )
#(#MenuItem #label: 'bar 2' #value:#bar2 )
)
nil
nil
)
)
)
#( 2 )
nil
) decodeAsLiteralArray.
menu verticalLayout:false.
Transcript showCR:(menu startUp).
[exEnd]
"
! !
!MenuPanel class methodsFor:'instance creation'!
fromSpec:aSpec
^ self fromSpec:aSpec receiver:nil
!
fromSpec:aSpec receiver:aReceiver
|menu|
aSpec notNil ifTrue:[
menu := Menu new.
menu fromLiteralArrayEncoding:aSpec.
].
^ self menu:menu receiver:aReceiver
!
labels:labels
^ self labels:labels nameKeys:nil receiver:nil
!
labels:labels nameKeys:nameKeys
^ self labels:labels nameKeys:nameKeys receiver:nil
!
labels:labels nameKeys:nameKeys receiver:aReceiver
|mview|
mview := self menu:nil receiver:aReceiver.
mview labels:labels.
mview nameKeys:nameKeys.
^ mview
!
labels:labels receiver:aReceiver
^ self labels:labels nameKeys:nil receiver:aReceiver
!
menu:aMenu
^ self menu:aMenu receiver:nil
!
menu:aMenu receiver:aReceiver
|mview|
mview := self new.
mview menu:aMenu.
"/ a menu itself may contain a receiver
"/ thus we do not overwrite the receiver
aReceiver notNil ifTrue:[
mview receiver:aReceiver
].
^ mview
! !
!MenuPanel class methodsFor:'class initialization'!
initialize
"
DefaultAdornment := nil.
self initialize
"
InitialSelectionQuerySignal isNil ifTrue:[
InitialSelectionQuerySignal := QuerySignal new.
].
DefaultAdornment isNil ifTrue:[
DefaultAdornment := IdentityDictionary new
at:#showSeparatingLines put:false;
at:#showGroupDivider put:true;
at:#verticalLayout put:true;
at:#item put:nil;
at:#value put:nil;
yourself
].
"Modified: / 15.1.1998 / 23:08:31 / stefan"
! !
!MenuPanel class methodsFor:'defaults'!
updateStyleCache
|menuStyle style font|
menuStyle := MenuView styleSheet.
menuStyle isNil ifTrue:[
"make sure that style sheet is present"
MenuView updateStyleCache.
menuStyle := MenuView styleSheet.
].
style := menuStyle name.
DefaultForegroundColor := menuStyle colorAt:'pullDownMenu.foregroundColor'.
DefaultForegroundColor isNil ifTrue:[
DefaultForegroundColor := menuStyle colorAt:'menu.foregroundColor'
default:Color black.
].
(style == #motif or:[style == #iris]) ifTrue:[
DefaultBackgroundColor := DefaultViewBackgroundColor.
DefaultHilightForegroundColor := DefaultForegroundColor.
DefaultHilightLevel := 2.
DefaultLevel := 0.
] ifFalse:[
(DefaultHilightLevel := menuStyle at:'pullDownMenu.hilightLevel') isNil ifTrue:[
DefaultHilightLevel := menuStyle at:'menu.hilightLevel' default:0.
].
DefaultLevel := menuStyle at:'pullDownMenu.level' default:1.
DefaultBackgroundColor := menuStyle colorAt:'pullDownMenu.backgroundColor'.
DefaultBackgroundColor isNil ifTrue:[
DefaultBackgroundColor := menuStyle colorAt:'menu.backgroundColor'
default:DefaultViewBackgroundColor.
].
DefaultHilightForegroundColor := menuStyle colorAt:'pullDownMenu.hilightForegroundColor'.
DefaultHilightForegroundColor isNil ifTrue:[
DefaultHilightForegroundColor := menuStyle colorAt:'menu.hilightForegroundColor'
default:DefaultBackgroundColor
].
].
DefaultDisabledForegroundColor := menuStyle colorAt:'menu.disabledForegroundColor'.
DefaultDisabledForegroundColor isNil ifTrue:[
DefaultDisabledForegroundColor := menuStyle colorAt:'button.disabledForegroundColor'
default:Color darkGray.
].
style == #motif ifTrue:[
DefaultHilightBackgroundColor := DefaultBackgroundColor
] ifFalse:[
DefaultHilightBackgroundColor := menuStyle colorAt:'pullDownMenu.hilightBackgroundColor'.
DefaultHilightBackgroundColor isNil ifTrue:[
DefaultHilightBackgroundColor := menuStyle colorAt:'menu.hilightBackgroundColor'
default:DefaultBackgroundColor.
]
].
DefaultGroupDividerSize := menuStyle at:'menu.groupDividerSize' default:6.
DefaultItemSpace := menuStyle at:'menu.itemSpace' default:0.
DefaultFitFirstPanel := menuStyle at:'menu.fitFirstPanel' default:true.
font := menuStyle fontAt:'pullDownMenu.font'.
font isNil ifTrue:[font := menuStyle fontAt:'menu.font'].
DefaultFont := font.
RightArrowForm := SelectionInListView rightArrowFormOn:Display.
style ~~ #os2 ifTrue:[
RightArrowShadowForm := SelectionInListView rightArrowShadowFormOn:Display.
] ifFalse:[
RightArrowShadowForm := nil
].
Item updateStyleCache
"Modified: / 15.1.1998 / 22:59:44 / stefan"
! !
!MenuPanel class methodsFor:'private'!
subMenu:aSubMenu
"create a submenu; can be redifined in derived classes
"
^ (MenuPanel new) menu:aSubMenu.
! !
!MenuPanel class methodsFor:'resources'!
checkedImage
"ImageEditor openOnClass:self andSelector:#checkedImage"
<resource: #image>
^(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[255 255 255 255 234 170 170 169 229 85 85 85 228 21 85 5 228 5 84 5 229 1 80 21 229 64 64 85 229 80 1 85 229 84 5 85 229 80 1 85 229 64 64 85 229 1 80 21 228 5 84 5 228 21 85 5 229 85 85 85 213 85 85 85]) ; colorMap:(((Array new:4) at:1 put:((Color black)); at:2 put:((Color white)); at:3 put:((Color grey:49.9962)); at:4 put:((Color grey:66.9978)); yourself)); yourself!
uncheckedImage
"ImageEditor openOnClass:self andSelector:#uncheckedImage"
<resource: #image>
^(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[170 170 170 170 149 85 85 84 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 128 0 0 0]) ; colorMap:((OrderedCollection new add:(Color white); add:(Color grey:49.9977); add:(Color grey:66.9978); add:(Color black); yourself)); yourself! !
!MenuPanel methodsFor:'accept'!
accept
"accept current selected item
"
^ self accept:(self selection)
!
accept:anItem
"this is the topMenu: accept item
"
|value item tgState itemIdx recv|
self superMenu notNil ifTrue:[
^ self topMenu accept:anItem
].
self selection:nil.
self forceUngrabMouseAndKeyboard.
(anItem notNil and:[anItem canAccept]) ifTrue:[
tgState := anItem toggleIndication.
itemIdx := anItem menuPanel findFirst:[:el| el == anItem ].
item := anItem.
recv := anItem menuPanel receiver.
].
self isPopUpView ifFalse:[
self do:[:el| el updateIndicators].
self windowGroup processExposeEvents.
] ifTrue:[
self destroy
].
value := self accept:item index:itemIdx toggle:tgState receiver:recv.
self isPopUpView ifTrue:[
self menuAdornmentAt:#value put:value.
self menuAdornmentAt:#item put:item.
].
^ item.
!
accept:anItem index:anIndex toggle:aState receiver:aReceiver
"accept an item
"
|value argument numArgs isKindOfValueModel|
anItem isNil ifTrue:[
self menuAdornmentAt:#hasPerformed put:true.
^ nil
].
self menuAdornmentAt:#hasPerformed put:(aReceiver isKindOf:ValueModel).
(value := anItem value) isNil ifTrue:[
^ anIndex
].
(argument := anItem argument) isNil ifTrue:[
argument := aState
].
value isSymbol ifFalse:[
(value respondsTo:#numArgs) ifTrue:[numArgs := value numArgs]
ifFalse:[numArgs := 0].
numArgs == 0 ifTrue:[
value value
] ifFalse:[
numArgs == 1 ifTrue:[value value:argument]
ifFalse:[value value:argument value:self]
].
self menuAdornmentAt:#hasPerformed put:true.
^ anIndex
].
aReceiver isNil ifTrue:[
^ value
].
isKindOfValueModel := aReceiver isKindOf:ValueModel.
(numArgs := value numArgs) == 0 ifTrue:[
isKindOfValueModel ifFalse:[aReceiver perform:value]
ifTrue:[aReceiver value:value]
] ifFalse:[
numArgs == 1 ifTrue:[
isKindOfValueModel ifFalse:[aReceiver perform:value with:argument]
ifTrue:[aReceiver value:value value:argument]
] ifFalse:[
isKindOfValueModel ifFalse:[aReceiver perform:value with:argument with:self]
ifTrue:[aReceiver value:value value:argument value:self]
]
].
self menuAdornmentAt:#hasPerformed put:true.
^ value
!
lastItemAccepted
"returns last item selected or nil
"
^ self topMenu menuAdornmentAt:#item
!
lastValueAccepted
"returns last value accepted or nil
"
|top|
top := self topMenu.
(top menuAdornmentAt:#hasPerformed) ~~ true ifTrue:[
^ self topMenu menuAdornmentAt:#value.
].
^ nil
! !
!MenuPanel methodsFor:'accessing'!
accessCharacterPositionAt:stringOrNumber
"get the access character position for a textLabel
"
^ self itemAt:stringOrNumber do:[:el| el accessCharacterPosition ]
!
accessCharacterPositionAt:stringOrNumber put:anIndexOrNil
"get the access character position for a textLabel
"
self itemAt:stringOrNumber do:[:el| el accessCharacterPosition:anIndexOrNil ]
!
accessCharacterPositions
"returns a collection of accessCharacterPosition's or nil
"
^ self collect:[:anItem| anItem accessCharacterPosition ]
!
accessCharacterPositions:something
"define accessCharacterPosition's for each item
"
self onEachPerform:#accessCharacterPosition: withArgList:something
!
args
"returns a collection of argument's or nil
"
^ self collect:[:anItem| anItem argument ]
!
args:something
"define arguments for each item
"
self onEachPerform:#argument: withArgList:something
!
argsAt:stringOrNumber
"gets the argument of an item or nil
"
^ self itemAt:stringOrNumber do:[:el| el argument ]
!
argsAt:stringOrNumber put:anArgument
"sets the argument of an item
"
self itemAt:stringOrNumber do:[:el| el argument:anArgument ]
!
groupSizes
"gets collection of group sizes
"
^ groupSizes
!
groupSizes:aGroupSizes
"sets collection of group sizes
"
aGroupSizes = groupSizes ifFalse:[
groupSizes := aGroupSizes copy.
self mustRearrange.
].
!
labelAt:stringOrNumber
"gets the label of an item or nil
"
^ self itemAt:stringOrNumber do:[:el| el label ]
!
labelAt:stringOrNumber put:aLabel
"sets the label of an item
"
self itemAt:stringOrNumber do:[:el| el label:aLabel ]
!
labels
"returns a collection of labels's or nil
"
^ self collect:[:anItem| anItem label ]
!
labels:labels
"define labels for each item
"
self disabledRedrawDo:[
self removeAll.
labels notNil ifTrue:[
labels do:[:aLabel|(self createAtIndex:nil) label:aLabel]
]
]
!
nameKeyAt:stringOrNumber
"gets the nameKey of an item or nil
"
^ self itemAt:stringOrNumber do:[:el| el nameKey ]
!
nameKeyAt:stringOrNumber put:aNameKey
"sets the nameKey of an item
"
self itemAt:stringOrNumber do:[:el| el nameKey:aNameKey ]
!
nameKeys
"returns a collection of nameKeys's or nil
"
^ self collect:[:anItem| anItem nameKey ]
!
nameKeys:something
"define nameKeys for each item
"
self onEachPerform:#nameKey: withArgList:something
!
numberOfItems
"gets number of items
"
^ items size
!
receiver
"get the menu-receiver. Thats the one who gets the messages ( both from myself and
from all submenus no specific receiver is defined ).
"
(receiver isNil and:[superMenu notNil]) ifTrue:[
^ superMenu receiver
].
^ receiver
!
receiver:anObject
"set the menu-receiver. Thats the one who gets the messages ( both from myself and
from all submenus no specific receiver is defined ).
"
receiver := anObject
!
shortcutKeyAt:stringOrNumber
"gets the shortCutKey of an item or nil
"
^ self itemAt:stringOrNumber do:[:el| el shortcutKey ]
!
shortcutKeyAt:stringOrNumber put:aKey
"sets the shortCutKey of an item
"
self itemAt:stringOrNumber do:[:el| el shortcutKey:aKey ]
!
shortcutKeys
"returns a collection of shortcutKey's or nil
"
^ self collect:[:anItem| anItem shortcutKey ]
!
shortcutKeys:something
"define shortcutKey's for each item
"
self onEachPerform:#shortcutKey: withArgList:something
!
valueAt:stringOrNumber
"gets value of an item; a block, valueHolder, ...
"
^ self itemAt:stringOrNumber do:[:el| el value ]
!
valueAt:stringOrNumber put:someThing
"sets value of an item; a block, valueHolder, ...
"
self itemAt:stringOrNumber do:[:el| el value:someThing ]
!
values:something
"define values for each item
"
self onEachPerform:#value: withArgList:something
! !
!MenuPanel methodsFor:'accessing behavior'!
disable
"disable the menu
"
self enabled:false
!
disableAll
"disable all items; not the menu in case of enabled
"
self do:[:anItem| anItem enabled:false]
!
disableAll:collectionOfIndicesOrNames
"disable an collection of items
"
collectionOfIndicesOrNames do:[:entry| self enabledAt:entry put:false ].
!
enable
"enable the menu
"
self enabled:true
!
enableAll
"enable all items; not the menu in case of disabled
"
self do:[:anItem| anItem enabled:true]
!
enableAll:collectionOfIndicesOrNames
"enable an collection of items
"
collectionOfIndicesOrNames do:[:entry| self enabledAt:entry put:true ].
!
enabled
"returns enabled state
"
^ enabled
!
enabled:aState
"change enabled state of menu
"
|state|
state := aState ? true.
self enabled == state ifTrue:[
^ self
].
enabled := state.
self canDrawItem ifTrue:[
self do:[:anItem| anItem enabledStateOfMenuChangedTo:enabled]
].
!
enabledAt:stringOrNumber
"gets the enabled state of an item or false
"
^ self itemAt:stringOrNumber do:[:el| el enabled ] ifAbsent:false
!
enabledAt:stringOrNumber put:aState
"sets the enabled state of an item
"
self itemAt:stringOrNumber do:[:el| el enabled:aState ]
!
isEnabled:stringOrNumber
"gets the enabled state of an item or false
"
^ self enabledAt:stringOrNumber
! !
!MenuPanel methodsFor:'accessing channels'!
enableChannel
"gets a enable channel or nil
"
^ enableChannel
!
enableChannel:aValueHolder
"set my enableChannel
"
enableChannel notNil ifTrue:[
enableChannel removeDependent:self
].
(enableChannel := aValueHolder) notNil ifTrue:[
enableChannel addDependent:self.
].
self enabled:(enableChannel value).
!
menuHolder
"gets a menu holder or nil
"
^ menuHolder
!
menuHolder:aValueHolder
"set my menuHolder
"
menuHolder notNil ifTrue:[
menuHolder removeDependent:self
].
(menuHolder := aValueHolder) notNil ifTrue:[
menuHolder addDependent:self.
].
self menu:(menuHolder value)
! !
!MenuPanel methodsFor:'accessing color & font'!
activeBackgroundColor
"get the background drawing color used to highlight selection
"
^ activeBgColor
!
activeBackgroundColor:aColor
"set the background drawing color used to highlight selection. You should not
use this method; instead leave the value as defined in the styleSheet.
"
activeBgColor ~~ aColor ifTrue:[
activeBgColor := aColor on:device.
self invalidate
]
!
activeForegroundColor
"get the foreground color used to highlight selections
"
^ activeFgColor
!
activeForegroundColor:aColor
"set the foreground color used to highlight selections; You should not
use this method; instead leave the value as defined in the styleSheet.
"
activeFgColor ~~ aColor ifTrue:[
activeFgColor := aColor on:device.
self invalidate
]
!
backgroundColor
"return the background color
"
^ super viewBackground
!
backgroundColor:aColor
"set the background drawing color. You should not use this method;
instead leave the value as defined in the styleSheet.
"
super viewBackground ~~ aColor ifTrue:[
super viewBackground:aColor.
shown ifTrue:[self invalidate]
]
!
disabledForegroundColor
"return the foreground color used by disabled items
"
^ disabledFgColor
!
disabledForegroundColor:aColor
"set the foregroundColor drawing color used by disabled items. You should not
use this method; instead leave the value as defined in the styleSheet.
"
disabledFgColor ~~ aColor ifTrue:[
disabledFgColor := aColor on:device.
self invalidate
].
!
font:aFont
"set the font
"
superMenu notNil ifTrue:[
self topMenu font:aFont
] ifFalse:[
(aFont notNil and:[aFont ~~ font]) ifTrue:[
super font:(aFont on:device).
self mustRearrange.
]
]
!
foregroundColor
"return the passive foreground color
"
^ fgColor
!
foregroundColor:aColor
"set the foregroundColor drawing color. You should not use this method;
instead leave the value as defined in the styleSheet.
"
fgColor ~~ aColor ifTrue:[
fgColor := aColor on:device.
shown ifTrue:[self invalidate]
]
!
lightColor
"get the lightColor
"
^ lightColor
!
lightColor:aColor
"set the light drawing color. You should not use this method;
instead leave the value as defined in the styleSheet.
"
lightColor ~~ aColor ifTrue:[
super lightColor:aColor.
shown ifTrue:[self invalidate]
]
!
shadowColor
"get the shadowColor
"
^ shadowColor
!
shadowColor:aColor
"set the shadow drawing color. You should not use this method;
instead leave the value as defined in the styleSheet.
"
shadowColor ~~ aColor ifTrue:[
super shadowColor:aColor.
shown ifTrue:[self invalidate]
]
! !
!MenuPanel methodsFor:'accessing dimensions'!
height
"default height
"
|item|
(explicitExtent ~~ true) ifTrue:[
(item := self itemAt:1) notNil ifTrue:[
self rearrangeItems.
^ item height
].
^ 4 + (font height + (font descent * 2)).
].
^ super height
!
preferredExtent
"compute and returns my preferred extent
"
|x y hasMenu shCtKey space hrzInset|
self numberOfItems == 0 ifTrue:[
^ 32 @ 32
].
space := (items size + 1) * itemSpace.
self isFitPanel ifTrue:[
x := 0
] ifFalse:[
x := groupSizes size * groupDividerSize.
].
hrzInset := items first horizontalInset.
self verticalLayout ifFalse:[
y := 0.
self do:[:el||z|
x := x + el preferredExtentX.
y < (z := el preferredExtentY) ifTrue:[y := z]
].
x := x + space.
] ifTrue:[
hasMenu := false.
shCtKey := 0.
y := x.
x := 0.
self do:[:el| |l e|
(l := el rawLabel) notNil ifTrue:[
(e := l widthOn:self) > x ifTrue:[x := e].
(el hasSubmenu or:[el submenuChannel notNil]) ifTrue:[
hasMenu := true
].
( (l := el shortcutKeyAsString) notNil
and:[(e := l widthOn:self) > shCtKey]
) ifTrue:[
shCtKey := e
].
].
y := y + el preferredExtentY
].
x := x + hrzInset.
(hasMenu or:[shCtKey ~~ 0]) ifTrue:[
shortKeyInset := x + Item labelRightOffset.
x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
(shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
x := x + (Item shortcutKeyOffset)
]
].
y := y + space.
x := x + hrzInset.
].
^ x @ y
!
shortKeyInset
"left inset of shortcutKey
"
^ shortKeyInset
!
subMenuIndicationWidth
^ RightArrowForm width
! !
!MenuPanel methodsFor:'accessing items'!
itemAt:stringOrNumber
"returns item assigned to an index, nameKey, textLabel or value if symbol.
If no item match nil is returned.
"
|idx|
idx := self indexOf:stringOrNumber.
(idx > 0 and:[idx <= items size]) ifTrue:[ ^ items at:idx ].
^ nil
!
itemAt:stringOrNumber do:aOneArgBlock
"evaluate teh block for an item and return the result from the block. In case that
the item not exists nil is returned
"
^ self itemAt:stringOrNumber do:aOneArgBlock ifAbsent:nil
!
itemAt:stringOrNumber do:aOneArgBlock ifAbsent:exceptionBlock
"evaluate teh block for an item and return the result from the block. In case that
the item not exists the result of the exception block is returned (no arguments).
"
|item|
item := self itemAt:stringOrNumber.
item notNil ifTrue:[ ^ aOneArgBlock value:item ].
^ exceptionBlock value
! !
!MenuPanel methodsFor:'accessing look'!
fitFirstPanel
"gets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
"
^ fitFirstPanel
!
fitFirstPanel:aState
"sets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
"
(fitFirstPanel == aState or:[self isPopUpView]) ifFalse:[
fitFirstPanel := aState.
self mustRearrange
]
!
groupDividerSize
"get the size of the group dividers
"
^ groupDividerSize
!
groupDividerSize:aSize
"set the size of the group dividers. You should not use this
method; instead leave the value as defined in the styleSheet.
"
aSize ~~ groupDividerSize ifTrue:[
groupDividerSize := aSize.
self mustRearrange.
].
!
itemSpace
"get the space space between to items
"
^ itemSpace
!
itemSpace:aSize
"set the horizontal space between to items. You should not use this
method; instead leave the value as defined in the styleSheet.
"
aSize ~~ itemSpace ifTrue:[
itemSpace := aSize.
self mustRearrange
].
!
rightArrow
^ rightArrow
!
rightArrowShadow
^ rightArrowShadow
!
showGroupDivider
"get the enabled flag for showing groupDiveders
"
^ self menuAdornmentAt:#showGroupDivider
!
showGroupDivider:aState
"set the enabled flag for showing groupDiveders
"
(self menuAdornmentAt:#showGroupDivider put:aState) ifTrue:[
self mustRearrange.
]
!
showSeparatingLines
"gets true if drawing of separating lines is enabled.
"
^ self menuAdornmentAt:#showSeparatingLines
!
showSeparatingLines:aState
"turn on/off drawing of separating lines.
"
(self menuAdornmentAt:#showSeparatingLines put:aState) ifTrue:[
self mustRearrange
]
!
verticalLayout
"get the layout: or vertical( true ) or horizontal( false )
"
^ self menuAdornmentAt:#verticalLayout
!
verticalLayout:aState
"set the layout: or vertical( true ) or horizontal( false )
"
(self menuAdornmentAt:#verticalLayout put:aState) ifTrue:[
self mustRearrange
]
! !
!MenuPanel methodsFor:'accessing submenu'!
subMenuAt:stringOrNumber
"gets the submenu of an item or nil
"
^ self itemAt:stringOrNumber do:[:el| el submenu ]
!
subMenuAt:stringOrNumber put:aSubMenu
"sets the submenu of an item
"
self itemAt:stringOrNumber do:[:el| el submenu:aSubMenu ]
!
subMenuShown
"return the currently visible submenu - or nil if there is none
"
|item|
(item := self selection) notNil ifTrue:[
^ item submenu
].
^ nil
! !
!MenuPanel methodsFor:'activation'!
hide
"hide the view, leave its modal event loop
"
self selection:nil.
self unmap.
!
show
"realize the view at its last position
"
^ self showAt:(self origin) resizing:true
!
showAt:aPoint
"realize the view at aPoint
"
^ self showAt:aPoint resizing:true
!
showAt:aPoint resizing:aBoolean
"realize the view at aPoint
"
self rearrangeItems.
aBoolean ifTrue:[
self fixSize.
].
self origin:aPoint.
self makeFullyVisible.
self openModal:[true]. "realize "
^ self lastValueAccepted
!
showAtPointer
"realize the view at the current pointer position
"
^ self showAt:(device pointerPosition) resizing:true
!
showCenteredIn:aView
"make myself visible at the screen center.
"
|top|
top := aView topView.
top raise.
^ self showAt:(top origin + (aView originRelativeTo:top) + (aView extent // 2) - (self extent // 2))
!
startUp
"realize the menu at the current pointer position
"
^ self showAtPointer
! !
!MenuPanel methodsFor:'active help'!
helpText
|appl item key|
(item := self selection) notNil ifTrue:[
(key := item activeHelpKey) notNil ifTrue:[
(appl := self application) notNil ifTrue:[
^ appl helpTextForKey:key
].
]
].
^ nil.
! !
!MenuPanel methodsFor:'adding & removing'!
createAtIndex:anIndexOrNil
"create an item and add this item to the index. In case of nil the item
is added to the end. If the index is not valid nil is returned otherwise
the new created item.
"
|max item|
max := (items size) + 1.
anIndexOrNil notNil ifTrue:[
(anIndexOrNil < 1 or:[anIndexOrNil > max]) ifTrue:[
^ nil
]
].
items isNil ifTrue:[
items := OrderedCollection new
].
item := Item in:self.
(anIndexOrNil isNil or:[anIndexOrNil == max]) ifTrue:[
items add:item
] ifFalse:[
items add:item beforeIndex:anIndexOrNil
].
^ item
!
remove:stringOrNumber
"remove the first item which is assigned to stringOrNumber;
if found, remove and return it
"
|item|
(item := self itemAt:stringOrNumber) notNil ifTrue:[
items remove:item.
item destroy.
items isEmpty ifTrue:[items := nil].
self mustRearrange.
].
^ item
!
removeAll
"remove all items and submenus
"
self disabledRedrawDo:[
self selection:nil.
groupSizes := nil.
self do:[:el| el destroy ].
items := nil
].
! !
!MenuPanel methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == menuHolder ifTrue:[^ self menu:(menuHolder value)].
changedObject == enableChannel ifTrue:[^ self enabled:(enableChannel value)].
super update:something with:aParameter from:changedObject
! !
!MenuPanel methodsFor:'converting'!
asMenu
"convert contents to menu
"
|menu|
menu := Menu new.
menu groupSizes:groupSizes.
self do:[:anItem| menu addItem:(anItem asMenuItem) ].
^ menu
!
fromSpec:aMenuSpec
"build from spec
"
|menu|
menu := Menu new.
menu fromLiteralArrayEncoding:aMenuSpec.
self menu:menu
!
menu:aMenu
"convert to Menu
"
|menu|
self disabledRedrawDo:[
self removeAll.
(menu := aMenu) notNil ifTrue:[
(aMenu isCollection) ifTrue:[
menu := Menu new.
menu fromLiteralArrayEncoding:aMenu.
] ifFalse:[
menu receiver notNil ifTrue:[receiver := menu receiver]
].
menu menuItems notNil ifTrue:[
menu menuItems do:[:anItem|
(self createAtIndex:nil) menuItem:anItem
]
].
self groupSizes:(menu groupSizes).
]
]
! !
!MenuPanel methodsFor:'drawing'!
disabledRedrawDo:aBlock
"evaluate a block without redrawing within the block; after processing
of the block a redraw might be performed
"
|state|
state := mustRearrange.
mustRearrange := true.
aBlock value.
mustRearrange := state.
self mustRearrange
!
drawEdgesForX:x y:y width:w height:height isSelected:aBool
|level r2 r h|
level := aBool ifTrue:[onLevel] ifFalse:[offLevel].
level ~~ 0 ifTrue:[
self drawEdgesForX:x y:y width:w height:height level:level
].
!
mustRearrange
"returns true if layout of items must be recomputed
"
mustRearrange == true ifFalse:[
mustRearrange := true.
self invalidate.
]
"Modified: / 29.10.1997 / 15:48:33 / cg"
!
rearrangeItems
"recompute layout of my items
"
|expLast x y e grpDivSz layout isVert|
mustRearrange ifFalse:[ ^ self ].
"/ fetch font from superMenu
(superMenu notNil and:[superMenu font ~~ font]) ifTrue:[
super font:(superMenu font on:device)
].
items isNil ifTrue:[
mustRearrange := false.
^ self
].
expLast := false.
isVert := self verticalLayout.
self hasGroupDividers ifTrue:[
self isFitPanel ifFalse:[
grpDivSz := groupDividerSize
] ifTrue:[
expLast := true.
x := 0.
e := self computeExtent.
isVert ifTrue:[
items do:[:el|x := x + el preferredExtentY].
y := e y.
] ifFalse:[
items do:[:el|x := x + el preferredExtentX].
y := e x.
].
x := x + (items size + 1 * itemSpace).
(grpDivSz := (y - x) // (groupSizes size)) <= 0 ifTrue:[
grpDivSz := nil
]
]
].
(self isPopUpView or:[explicitExtent ~~ true]) ifTrue:[
e := self preferredExtent.
self isPopUpView ifFalse:[
isVert ifTrue:[e y:1.0]
ifFalse:[e x:1.0]
].
self extent:e
] ifFalse:[
e := self computeExtent
].
x := y := 0.
isVert ifTrue:[y := itemSpace]
ifFalse:[x := itemSpace].
self keysAndValuesDo:[:anIndex :el||org|
org := Point x:x y:y.
isVert ifTrue:[
y := y + el preferredExtentY.
el layout:(Rectangle origin:org corner:(e x @ y)).
y := y + itemSpace.
] ifFalse:[
x := x + el preferredExtentX.
el layout:(Rectangle origin:org corner:(x @ e y)).
x := x + itemSpace.
].
(grpDivSz notNil and:[self hasGroupDividerAt:anIndex]) ifTrue:[
isVert ifTrue:[y := y + grpDivSz]
ifFalse:[x := x + grpDivSz]
]
].
expLast ifTrue:[
layout := items last layout.
isVert ifTrue:[layout bottom:((self extent y) + 1)]
ifFalse:[layout right:((self extent x) + 1)].
].
mustRearrange := false.
!
redrawX:x y:y width:w height:h
"redraw a rectangle
"
|start end isVrt x1 x2 y1 y2 item layout lnSz hrzInset prevClipArea|
shown ifFalse:[^ self].
self paint:(self backgroundColor).
self clearRectangleX:x y:y width:w height:h.
isVrt := self verticalLayout.
end := items size.
mustRearrange ifTrue:[
self isPopUpView not ifTrue:[
explicitExtent := true
].
self rearrangeItems.
start := 1
] ifFalse:[
end == 0 ifTrue:[ ^ self ].
isVrt ifTrue:[
start := self findFirst:[:el| (el layout bottom) >= y ].
start == 0 ifTrue:[ ^ self ].
end := y + h.
end := self findLast:[:el| (el layout top) < end ].
] ifFalse:[
start := self findFirst:[:el| (el layout right) >= x ].
start == 0 ifTrue:[ ^ self ].
end := x + w.
end := self findLast:[:el| (el layout left) < end ].
].
(start ~~ 1 and:[self hasGroupDividerAt:(start-1)]) ifTrue:[
start := start - 1
]
].
( self hasGroupDividers
and:[self showGroupDivider
and:[self isFitPanel not]]
) ifTrue:[
lnSz := groupDividerSize // 2
].
end == 0 ifTrue:[^ self ].
hrzInset := items first horizontalInset.
prevClipArea := clipRect.
clipRect := nil.
device setClipX:x y:y width:w height:h in:drawableId gc:gcId.
start to:end do:[:i|
item := items at:i.
item redraw.
(lnSz notNil and:[self hasGroupDividerAt:i]) ifTrue:[
layout := item layout.
isVrt ifTrue:[
x1 := layout left + hrzInset.
x2 := layout right - hrzInset.
y1 := (layout bottom) + lnSz.
y2 := y1.
] ifFalse:[
x1 := (layout right) + lnSz.
x2 := x1.
y1 := layout top.
y2 := layout bottom.
].
self paint:(self shadowColor).
self displayLineFromX:x1 y:y1 toX:x2 y:y2.
self paint:(self lightColor).
isVrt ifTrue:[y1 := y1 + 1. y2 := y1 ]
ifFalse:[x1 := x1 + 1. x2 := x1 ].
self displayLineFromX:x1 y:y1 toX:x2 y:y2
]
].
clipRect := nil.
prevClipArea isNil ifTrue:[device noClipIn:drawableId gc:gcId]
ifFalse:[self clippingRectangle:prevClipArea].
! !
!MenuPanel methodsFor:'enumerting & searching'!
collect:aOneArgBlock
"evaluate the argument, aOneArgBlock for every item in the menuPanel
and return a collection of the results
"
items notNil ifTrue:[^ items collect:aOneArgBlock ].
^ nil
!
do:aOneArgBlock
"evaluate the argument, aOneArgBlock for every item in the menuPanel.
"
items notNil ifTrue:[ items do:aOneArgBlock ].
!
findFirst:aOneArgBlock
"find the first item, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
items notNil ifTrue:[ ^ items findFirst:aOneArgBlock ].
^ 0
!
findLast:aOneArgBlock
"find the last item, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
items notNil ifTrue:[ ^ items findLast:aOneArgBlock ].
^ 0
!
indexOf:something
"returns index of an item assigned to an index, nameKey, textLabel or value if symbol.
If no item match 0 is returned. No range checks are performed on a number argument
"
|i v|
something isNumber ifTrue:[ ^ something ].
something isNil ifTrue:[ ^ 0 ].
i := self findFirst:[:el|(el nameKey = something) or: [el = something]].
i ~~ 0 ifTrue:[
^ i
].
something isSymbol ifTrue:[
i := self findFirst:[:el|
v := el value.
v isSymbol and:[v == something]
].
i ~~ 0 ifTrue:[
^ i
]
].
(something respondsTo:#string) ifTrue:[
v := something string.
^ self findFirst:[:el|el textLabel = v].
].
^ 0
!
keysAndValuesDo:aTwoArgBlock
"evaluate the argument, aTwoArgBlock for every item in the menuPanel.
"
items notNil ifTrue:[ items keysAndValuesDo:aTwoArgBlock ].
! !
!MenuPanel methodsFor:'event handling'!
buttonMotion:state x:x y:y
"open or close the corresponding submenus
"
|menu point sensor|
( (sensor := self sensor) notNil
and:[sensor hasButtonMotionEventFor:nil]
) ifTrue:[
^ self
].
(self containsPointX:x y:y) ifTrue:[
^ self selection:(self itemAtX:x y:y)
].
menu := self superMenuAtX:x y:y.
menu isNil ifTrue:[
^ self selection:nil
].
point := self translatePoint:(x@y) to:menu.
menu selection:(menu itemAtX:(point x) y:(point y))
!
buttonPress:button x:x y:y
"any button pressed; open or close the corresponding submenus
"
|menu point item|
menu := self superMenuAtX:x y:y.
menu isNil ifTrue:[
menu := self topMenu.
] ifFalse:[
point := self translatePoint:(x@y) to:menu.
item := menu itemAtX:(point x) y:(point y)
].
menu selection:item
!
buttonRelease:button x:x y:y
"button release action; accept selection and close all views
"
|menu|
menu := self lastActiveMenu.
( menu hasSelection or:[
(OperatingSystem millisecondTimeDeltaBetween:(Time millisecondClockValue)
and:(menu mapTime)) > 200]
) ifTrue:[
menu accept
]
!
cursorPressed:aKey
"handle a cursor key
"
|next submenu item
n "{ Class:SmallInteger }"
idx "{ Class:SmallInteger }"
first "{ Class:SmallInteger }"
|
(self hasSelection not and:[superMenu notNil]) ifTrue:[
^ superMenu cursorPressed:aKey
].
self verticalLayout ifTrue:[
aKey == #CursorLeft ifTrue:[^ self selection:nil].
aKey ~~ #CursorRight ifTrue:[next := aKey == #CursorDown].
] ifFalse:[
aKey == #CursorUp ifTrue:[^ self selection:nil].
aKey ~~ #CursorDown ifTrue:[next := aKey == #CursorRight].
].
next isNil ifTrue:[
(item := self selection) notNil ifTrue:[
(submenu := item submenu) notNil ifTrue:[
idx := submenu findFirst:[:el| el canSelect ].
^ submenu selectionIndex:idx
].
^ self selection:nil
].
^ self
].
first := self findFirst:[:el| el canSelect ].
first == 0 ifTrue:[^ self].
idx := self selectionIndex.
n := 1 + (self sensor compressKeyPressEventsWithKey:aKey).
n timesRepeat:[
next ifTrue:[
[((idx := idx + 1) <= items size and:[(items at:idx) canSelect not])
] whileTrue.
idx > items size ifTrue:[
idx := first
].
] ifFalse:[
[((idx := idx - 1) > 0 and:[(items at:idx) canSelect not])
] whileTrue.
idx < 1 ifTrue:[ idx := self findLast:[:el| el canSelect ] ]
]
].
self selectionIndex:idx
!
keyPress:key x:x y:y
"any key is pressed
"
|listOfItems item menu idx cIdx upperKey lowerKey|
menu := self.
[ menu shown ] whileFalse:[
(menu := superMenu) isNil ifTrue:[^ self]
].
key == #Return ifTrue:[
^ menu accept
].
( key == #CursorDown or:[key == #CursorUp
or:[key == #CursorLeft or:[key == #CursorRight]]]
) ifTrue:[
^ menu cursorPressed:key
].
listOfItems := self selectItemsForShortcutKey:key.
listOfItems notNil ifTrue:[
item := listOfItems first.
item hasSubmenu ifFalse:[
^ menu accept:item
].
^ self openMenusFromItems:listOfItems
].
(self hasSelection not and:[superMenu notNil]) ifTrue:[
(superMenu containsPoint:(self translatePoint:(x@y) to:superMenu)) ifTrue:[
menu := superMenu
]
].
cIdx := menu selectionIndex.
cIdx isNil ifTrue:[cIdx := 0].
upperKey := key asUppercase.
lowerKey := key asLowercase.
menu keysAndValuesDo:[:anIndex :el| |c l|
(el canSelect and:[(l := el textLabel) notNil]) ifTrue:[
l size ~~ 0 ifTrue:[
(c := el accessCharacter) notNil ifTrue:[
(c == upperKey or:[c == lowerKey]) ifTrue:[
^ menu selection:el
]
] ifFalse:[
((c := l first) == upperKey or:[c == lowerKey]) ifTrue:[
anIndex > cIdx ifTrue:[
^ menu selection:el
] ifFalse:[
idx isNil ifTrue:[
idx := anIndex
] ifFalse:[
anIndex > idx ifTrue:[
anIndex ~~ cIdx ifTrue:[
idx := anIndex
]
]
]
]
]
]
]
]
].
(item := menu itemAt:idx) isNil ifTrue:[
menu hasSelection ifFalse:[
(menu := menu superMenu) isNil ifTrue:[
^ super keyPress:key x:x y:y
]
]
].
menu selection:item.
!
pointerLeave:aState
super pointerLeave:aState.
!
sizeChanged:how
self isFitPanel ifTrue:[
self mustRearrange.
].
super sizeChanged:how
! !
!MenuPanel methodsFor:'grabbing'!
forceUngrabMouseAndKeyboard
"ungrap resources( mouse and keyboard )
"
|sensor|
device ungrabPointer.
(sensor := self sensor) notNil ifTrue:[
"/ make certain all X events have been received
device sync.
"/ now all events have been received.
"/ now, flush all pointer events
sensor flushKeyboardFor:nil
].
device ungrabKeyboard.
!
grabMouseAndKeyboard
"get exclusive access to pointer and keyboard
"
|sensor|
realized ifTrue:[
sensor := self sensor.
device activePointerGrab ~~ self ifTrue:[
sensor notNil ifTrue:[
sensor flushMotionEventsFor:nil.
].
(device grabPointerInView:self) ifFalse:[
Delay waitForSeconds:0.1.
(device grabPointerInView:self) ifFalse:[
"give up"
'PopUpView [warning]: could not grab pointer' errorPrintCR.
self unmap
]
]
].
device activeKeyboardGrab ~~ self ifTrue:[
sensor notNil ifTrue:[
device sync.
sensor flushKeyboardFor:nil
].
device grabKeyboardInView:self.
superMenu notNil ifTrue:[
self getKeyboardFocus
]
]
]
!
ungrabMouseAndKeyboard
"ungrap resources( mouse and keyboard )
"
|sensor|
sensor := self sensor.
superMenu notNil ifTrue:[
superMenu shown ifTrue:[
^ superMenu grabMouseAndKeyboard
]
] ifFalse:[
sensor anyButtonPressed ifTrue:[
^ self grabMouseAndKeyboard
]
].
device activePointerGrab == self ifTrue:[
device ungrabPointer.
].
device activeKeyboardGrab == self ifTrue:[
sensor notNil ifTrue:[
"/ make certain all X events have been received
device sync.
"/ now all events have been received.
"/ now, flush all pointer events
sensor flushKeyboardFor:self
].
device ungrabKeyboard.
].
(superMenu notNil and:[superMenu shown and:[superMenu isPopUpView]]) ifTrue:[
superMenu grabMouseAndKeyboard
].
! !
!MenuPanel methodsFor:'initialize / release'!
create
"create the shadow view for a none contained submenu
"
super create.
self isPopUpView ifTrue:[
(PopUpView styleSheet at:'popup.shadow' default:false) ifTrue:[
shadowView isNil ifTrue:[
shadowView := (ShadowView onDevice:device) for:self
]
]
] ifFalse:[
explicitExtent == true ifTrue:[
(self extent x) == (superView extent x) ifTrue:[
self verticalLayout:false
]
]
]
!
destroy
"destroy items and shadowView; remove dependencies
"
self lastActiveMenu:nil.
self do:[:el|el destroy].
menuHolder notNil ifTrue:[menuHolder removeDependent:self].
enableChannel notNil ifTrue:[enableChannel removeDependent:self].
super destroy.
superMenu := nil.
items := nil.
shadowView notNil ifTrue:[shadowView destroy].
!
fetchDeviceResources
"fetch device colors, to avoid reallocation at redraw time"
|style|
super fetchDeviceResources.
superMenu isNil ifTrue:[
fgColor := DefaultForegroundColor onDevice:device.
activeBgColor := DefaultHilightBackgroundColor onDevice:device.
activeFgColor := DefaultHilightForegroundColor onDevice:device.
disabledFgColor := DefaultDisabledForegroundColor onDevice:device.
rightArrow := RightArrowForm onDevice:device.
(rightArrowShadow := RightArrowShadowForm) notNil ifTrue:[
rightArrowShadow := rightArrowShadow onDevice:device
]
] ifFalse:[
fgColor := superMenu foregroundColor.
activeBgColor := superMenu activeBackgroundColor.
activeFgColor := superMenu activeForegroundColor.
disabledFgColor := superMenu disabledForegroundColor.
rightArrow := superMenu rightArrow.
rightArrowShadow := superMenu rightArrowShadow.
].
style := styleSheet name.
self isPopUpView ifFalse:[
(style == #motif or:[style == #iris]) ifTrue:[
self topView == self superView ifTrue:[
self level:2
]
]
] ifTrue:[
style == #next ifTrue:[
onLevel := offLevel := 0
] ifFalse:[
style == #openwin ifTrue:[
offLevel := 0.
]
]
].
!
initStyle
"initialize style specific stuff"
|font|
super initStyle.
onLevel := DefaultHilightLevel.
offLevel := DefaultLevel.
itemSpace := DefaultItemSpace.
groupDividerSize := DefaultGroupDividerSize.
fitFirstPanel := DefaultFitFirstPanel.
!
initialize
"set default configuration
"
|style|
super initialize.
style := styleSheet name.
(style ~~ #normal and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 1.
].
level := 1.
style == #st80 ifTrue:[
level := 0
].
enabled := true.
self origin:0.0@0.0.
originChanged := extentChanged := false.
explicitExtent := nil.
shortKeyInset := 0.
mustRearrange := false.
!
mapped
"grab the pointer here, when visible (but not control is already lost).
If the grab fails, try again and unmap myself if that fails too.
"
|anItemList|
self do:[:anItem| anItem fetchImages ].
mapTime := Time millisecondClockValue.
self topMenu lastActiveMenu:self.
super mapped.
anItemList := InitialSelectionQuerySignal raise.
self isPopUpView ifTrue:[
self grabMouseAndKeyboard
] ifFalse:[
super viewBackground:(self backgroundColor)
. ].
self do:[:el| el updateIndicators ].
anItemList size > 0 ifTrue:[
self redrawX:0 y:0 width:10000 height:10000.
self openMenusFromItems:anItemList.
].
!
realize
"realize menu and shadowView
"
super realize.
self isPopUpView ifTrue:[
self resize.
shadowView notNil ifTrue:[
shadowView realize.
].
self raise.
].
!
recreate
"this is called after a snapin. If the image was saved with an active menu,
hide the menu
"
self selection:nil.
super recreate.
!
unmap
"unmap view
"
self lastActiveMenu:nil.
self ungrabMouseAndKeyboard.
super unmap.
shadowView notNil ifTrue:[shadowView unmap].
! !
!MenuPanel methodsFor:'misc'!
raiseDeiconified
^ self raise
"Created: 21.6.1997 / 13:29:12 / cg"
!
superMenu
"returns supermenu or nil
"
^ superMenu
!
superMenu:aSuperMenu
"set the supermenu starting from
"
superMenu := aSuperMenu.
!
topMenu
"returns the topMenu; the one having no superMenu
"
|top|
top := self.
[ top superMenu notNil ] whileTrue:[
top := top superMenu
].
^ top
! !
!MenuPanel methodsFor:'private'!
application
|appl|
superMenu notNil ifTrue:[
^ superMenu application
].
(appl := super application) isNil ifTrue:[
windowGroup notNil ifTrue:[
appl := windowGroup mainGroup topViews first application
]
].
^ appl
!
menuAdornmentAt:aSymbol
"returns a value derived from adornment
"
|adm|
adm := adornment ? DefaultAdornment.
^ adm at:aSymbol ifAbsent:nil
!
menuAdornmentAt:aSymbol put:something
"sets a value for the specific menu; if the value differs to the
current stored value, true is returned otherwise false
"
(self menuAdornmentAt:aSymbol) == something ifTrue:[
^ false
].
adornment isNil ifTrue:[
adornment := DefaultAdornment copy
].
adornment at:aSymbol put:something.
^ true
!
onEachPerform:aSelector withArgList:aList
"on each item perform selector with an argument derived from aList
"
aList isCollection ifTrue:[
items size >= aList size ifTrue:[
aList keysAndValuesDo:[:anIndex :anArg|
(items at:anIndex) perform:aSelector with:anArg
]
]
] ifFalse:[
self do:[:anItem| anItem perform:aSelector with:aList ]
]
!
openMenusFromItems:anItemList
"open all menus derived from sequence of items
"
|item|
(anItemList isNil or:[anItemList isEmpty]) ifTrue:[
^ self
].
item := anItemList removeLast.
item enabled ifFalse:[
^ self
].
InitialSelectionQuerySignal answer:anItemList do:[
self selection:item
]
!
selectItemsForShortcutKey:aKey
"get sequence of items up to the item providing the key (inclusive). The
first entry into the collection is the item providing the key, the last
entry is the item in the topMenu( reverse )
"
|seq|
self do:[:anItem|
anItem isEnabled ifTrue:[
anItem shortcutKey = aKey ifTrue:[
seq := OrderedCollection new.
] ifFalse:[
anItem hasSubmenu ifTrue:[
seq := anItem submenu selectItemsForShortcutKey:aKey
]
].
seq notNil ifTrue:[
seq add:anItem.
^ seq
]
]
].
^ nil
!
translatePoint:aPoint to:aView
"translate a point into a views point; in case of no view nil is returned
"
aView notNil ifTrue:[
aView == self ifTrue:[^ aPoint].
^ device translatePoint:aPoint from:(self id) to:(aView id)
].
^ nil
! !
!MenuPanel methodsFor:'private activation'!
lastActiveMenu
superMenu notNil ifTrue:[
^ superMenu lastActiveMenu
].
^ lastActiveMenu ? self
!
lastActiveMenu:aMenu
superMenu notNil ifTrue:[
superMenu lastActiveMenu:aMenu
] ifFalse:[
lastActiveMenu := aMenu
]
!
mapTime
^ mapTime
! !
!MenuPanel methodsFor:'private searching'!
itemAtX:x y:y
"returns item at a point or nil
"
self do:[:el| (el containsPointX:x y:y) ifTrue:[^el] ].
^ nil
!
superMenuAtX:x y:y
"returns supermenu at a point or nil
"
|menu|
(self containsPointX:x y:y) ifTrue:[^ self].
menu := self.
[ (menu := menu superMenu) notNil ] whileTrue:[
(menu containsPoint:(self translatePoint:(x@y) to:menu)) ifTrue:[
^ menu
]
].
^ nil
! !
!MenuPanel methodsFor:'queries'!
canDrawItem
"returns true if an item could be drawn otherwise false
"
^ (mustRearrange not and:[self shown])
!
containsPoint:aPoint
"returns true if point is contained by the view
"
^ self containsPointX:(aPoint x) y:(aPoint y)
!
containsPointX:x y:y
"returns true if point is contained by the view
"
|ext|
(x >= 0 and:[y >= 0]) ifTrue:[
ext := self computeExtent.
^ (x < ext x and:[y < ext y])
].
^ false
!
hasGroupDividerAt:anIndex
"returns true if a divider is defined at an index
"
|i|
groupSizes size ~~ 0 ifTrue:[
i := 0.
groupSizes do:[:t|
(i := i + t) == anIndex ifTrue:[
^ true
]
]
].
^ false
!
hasGroupDividers
"returns true if any group divider exists
"
^ (items size ~~ 0 and:[groupSizes size ~~ 0])
!
isEnabled
"returns enabled state of menu and items
"
^ self enabled
!
isFitPanel
"returns true if the panel is the first in the menu hierarchy in must
be fit to the extent of its superView
"
^ self isPopUpView ifTrue:[false] ifFalse:[fitFirstPanel]
!
isPopUpView
"return true if view is a popup view; without decoration
and popUp to top immediately
"
^ superView isNil
!
isVerticalLayout
"returns true if vertical layout otherwise false( horizontal layout )
"
^ self verticalLayout
!
type
^ nil.
! !
!MenuPanel methodsFor:'selection'!
hasSelection
"returns true if a selection exists
"
^ self selection notNil
!
isValidSelection:something
"returns true if something could be selected
"
|item|
enabled ifTrue:[
(item := self itemAt:something) notNil ifTrue:[
^ item canSelect
]
].
^ false
!
selection
"returns current selected item or nil
"
^ selection
!
selection:anItemOrNil
"change selection to an item
"
|item newSel hlp|
selection isNumber ifTrue:[
newSel := self itemAt:anItemOrNil
] ifFalse:[
(anItemOrNil notNil and:[anItemOrNil canSelect]) ifTrue:[
newSel := anItemOrNil
]
].
selection == newSel ifTrue:[^ self].
(item := selection) notNil ifTrue:[
selection := nil.
item selected:false.
].
newSel isNil ifTrue:[
self isPopUpView ifFalse:[
self ungrabMouseAndKeyboard
].
^ self
].
selection := newSel.
ActiveHelp isActive ifTrue:[
hlp := ActiveHelp currentHelpListener.
hlp initiateHelpFor:self atX:1 y:1 now:true.
].
selection selected:true
!
selectionIndex
"returns index of current selection or 0
"
|item|
(item := self selection) notNil ifTrue:[
^ self findFirst:[:el| el == item ]
].
^ 0
!
selectionIndex:anIndex
"set selection at an index
"
self selection:(self itemAt:anIndex)
! !
!MenuPanel::Item class methodsFor:'accessing'!
horizontalInset
^ HorizontalInset
!
labelRightOffset
^ LabelRightOffset
!
shortcutKeyOffset
^ ShortcutKeyOffset
!
verticalInset
^ VerticalInset
! !
!MenuPanel::Item class methodsFor:'defaults'!
separatorSize:aType
"returns size of a separator
"
aType == #doubleLine ifTrue:[^ 10 ].
aType == #singleLine ifTrue:[^ 10 ].
^ 20
!
updateStyleCache
"setup defaults
self updateStyleCache
"
HorizontalInset := 4.
VerticalInset := 3.
HorizontalButtonInset := 5.
VerticalButtonInset := 5.
LabelRightOffset := 15.
ShortcutKeyOffset := 5.
IndicatorOn := MenuPanel checkedImage.
IndicatorOff := MenuPanel uncheckedImage.
! !
!MenuPanel::Item class methodsFor:'instance creation'!
in:aSuperMenu
^ self in:aSuperMenu label:nil
!
in:aSuperMenu label:aLabel
|item|
item := self new in:aSuperMenu.
item label:aLabel.
^ item
!
in:aSuperMenu menuItem:aMenuItem
|item|
item := self in:aSuperMenu.
item menuItem:aMenuItem.
^ item.
! !
!MenuPanel::Item methodsFor:'accept'!
canAccept
"returns true if item is acceptable
"
^ (self enabled and:[self hasSubmenu not])
!
toggleIndication
"toggle indication
"
|arg|
self hasIndication ifTrue:[
arg := self indicationValue not.
self indicationValue:arg.
].
^ arg
! !
!MenuPanel::Item methodsFor:'accessing'!
accessCharacter
"returns my accessCharacter or nil
"
accessCharacterPosition isNil ifTrue:[
^ nil
].
^ (rawLabel string) at:accessCharacterPosition
!
accessCharacterPosition
"get the access character position or nil
"
^ accessCharacterPosition
!
accessCharacterPosition:anIndex
"set the access character position or nil
"
|lbl|
( (accessCharacterPosition ~~ anIndex)
and:[(lbl := self textLabel) notNil]
) ifTrue:[
anIndex notNil ifTrue:[
(anIndex < 1 or:[anIndex > lbl size]) ifTrue:[
^ self
].
].
accessCharacterPosition := anIndex.
self updateRawLabel.
].
!
activeHelpKey
^ activeHelpKey
!
activeHelpKey:aHelpKey
activeHelpKey := aHelpKey
!
argument
"gets the argument
"
adornment isNil ifTrue:[^ nil ].
^ adornment argument
!
argument:anArgument
"sets the argument
"
self argument ~~ anArgument ifTrue:[
self adornment argument:anArgument.
]
!
compareAccessCharacterWith:aKey
"returns true if key is my access character
"
|s|
accessCharacterPosition notNil ifTrue:[
s := (rawLabel string) at:accessCharacterPosition.
s == aKey ifTrue:[^ true ].
].
^ false
!
label
"returns the label
"
^ label
!
label:aLabel
"set a new label; if the label changed, a redraw is performed;
handle characters $& (ST-80 compatibility)
"
|i rest s|
accessCharacterPosition := nil.
label := aLabel value.
(label isString and:[(s := label size) > 1]) ifTrue:[
i := 1.
[((i := label indexOf:$& startingAt:i) ~~ 0 and:[i < s])] whileTrue:[
rest := label copyFrom:(i+1).
i == 1 ifTrue:[label := rest]
ifFalse:[label := (label copyFrom:1 to:(i-1)), rest].
(label at:i) == $& ifTrue:[i := i + 1]
ifFalse:[accessCharacterPosition := i].
s := s - 1.
]
].
self updateRawLabel
!
menuPanel
"returns my menuPanel
"
^ menuPanel
!
nameKey
"gets the nameKey
"
^ nameKey
!
nameKey:aNameKey
"sets the nameKey
"
nameKey := aNameKey.
!
rawLabel
"returns my printable Label
"
^ rawLabel
!
shortcutKey
"get the key to press to select the submenu from the keyboard or if
no submenu exists evaluate the action assigned to the item (accept).
"
adornment isNil ifTrue:[^ nil ].
^ adornment shortcutKey
!
shortcutKey:aKey
"set the key to press to select the submenu from the keyboard or if
no submenu exists evaluate the action assigned to the item (accept).
"
self shortcutKey ~~ aKey ifTrue:[
self adornment shortcutKey:aKey.
self redraw.
].
!
submenu
"returns my submenu or nil
"
subMenu notNil ifTrue:[^ subMenu].
^ self setupSubmenu
!
submenu:aSubMenu
"set a new submenu; an existing submenu will be destroyed. This might lead
to a redraw if 'hasSubmenu' changed
"
(aSubMenu notNil
and:[(aSubMenu isView or:[aSubMenu isKindOf:Menu]) not]) ifTrue:[
^ self submenuChannel:aSubMenu
].
(subMenu := aSubMenu) notNil ifTrue:[
aSubMenu class == Menu ifTrue:[
subMenu := menuPanel class subMenu:aSubMenu
].
(subMenu notNil and:[subMenu isView]) ifTrue:[
subMenu superMenu:menuPanel
]
].
"Modified: / 27.10.1997 / 04:43:43 / cg"
!
textLabel
"returns my textLabel or nil if none text
"
(rawLabel respondsTo:#string) ifTrue:[
^ rawLabel string
].
^ nil
!
value
"gets value
"
^ value
!
value:something
"could be a value holder, an action or selector
"
value := something.
!
value:aValue argument:anArgument
"set the value and an argument
"
self value:aValue.
self argument:anArgument.
! !
!MenuPanel::Item methodsFor:'accessing behavior'!
enabled
"returns the enabled state
"
|state|
menuPanel enabled ifTrue:[
enableChannel isSymbol ifTrue:[
state := self aspectAt:enableChannel.
(self isKindOfValueHolder:state) ifTrue:[
enableChannel := state.
enableChannel addDependent:self.
state := enableChannel value.
]
] ifFalse:[
state := enableChannel value
].
^ state ~~ false
].
^ false
!
enabled:something
"change the enabled state; if the state changed, a redraw is performed
"
|oldState newState|
enableChannel isNil ifTrue:[
oldState := true
] ifFalse:[
oldState := enableChannel value.
(self isKindOfValueHolder:enableChannel) ifTrue:[
enableChannel removeDependent:self
]
].
enableChannel := something.
enableChannel isNil ifTrue:[
menuPanel shown ifFalse:[^ self].
newState := true
] ifFalse:[
(self isKindOfValueHolder:enableChannel) ifTrue:[
enableChannel addDependent:self
] ifFalse:[
enableChannel isSymbol ifTrue:[^ self]
].
menuPanel shown ifFalse:[^ self].
newState := enableChannel value.
].
newState ~~ oldState ifTrue:[
(rawLabel notNil and:[menuPanel canDrawItem]) ifTrue:[
self drawLabel
]
]
"Modified: / 27.10.1997 / 16:13:42 / cg"
!
indication
"get on/off indication
"
adornment isNil ifTrue:[^ nil].
^ adornment indication
!
indication:something
"set on/off indication
"
|old|
old := self indication.
old == something ifTrue:[^ self].
(self isKindOfValueHolder:old) ifTrue:[
old removeDependent:self
].
(self isKindOfValueHolder:something) ifTrue:[
something addDependent:self
].
self adornment indication:something.
self updateRawLabel.
!
isButton
"returns whether item looks like a Button
"
^isButton ? false
!
isButton:anBoolean
"sets whether item looks like a Button
"
isButton := anBoolean.
layout notNil ifTrue: [self redrawAsButton]
!
setupSubmenu
|appl recv subm|
submenuChannel notNil ifTrue:[
submenuChannel isSymbol ifFalse:[
subm := submenuChannel
] ifTrue:[
appl := menuPanel application.
(subm := self findSubMenuIn:appl) isNil ifTrue:[
(recv := menuPanel receiver) ~~ appl ifTrue:[
subm := self findSubMenuIn:recv
]
]
].
(subm := subm value) isArray ifTrue:[
subm := Menu new fromLiteralArrayEncoding:subm.
].
self submenu:subm.
].
^ subMenu
!
submenuChannel
"get the submenu channel
"
^ submenuChannel
!
submenuChannel:aSelectorOrNil
"returns the submenu channel
"
submenuChannel := aSelectorOrNil.
! !
!MenuPanel::Item methodsFor:'accessing dimension'!
height
"gets height
"
layout isNil ifTrue:[
^ self preferredExtentY
].
^ layout height
!
horizontalInset
self isButton ifTrue: [^HorizontalButtonInset].
^HorizontalInset
!
layout
"returns my layout ( Rectangle )
"
^ layout
!
layout:aLayout
"set a new layout ( Rectangle )
"
layout := aLayout.
self redraw.
!
preferredExtentX
"compute my preferred extent x
"
|x s isVertical|
x := self horizontalInset * 2.
isVertical := menuPanel verticalLayout.
self isSeparator ifFalse:[
x := x + (rawLabel widthOn:menuPanel).
(s := self shortcutKeyAsString) notNil ifTrue:[
x := x + LabelRightOffset + (s widthOn:menuPanel)
].
(isVertical and:[self hasSubmenu or:[submenuChannel notNil]]) ifTrue:[
x := x + menuPanel subMenuIndicationWidth.
s notNil ifTrue:[x := x + ShortcutKeyOffset]
ifFalse:[x := x + LabelRightOffset]
].
^ x
].
isVertical ifFalse:[
^ x max:(self class separatorSize:(self separatorType))
].
^ x
!
preferredExtentY
"compute my preferred extent y
"
|y|
y := self verticalInset * 2.
self isSeparator ifFalse:[
^ y + (rawLabel heightOn:menuPanel)
].
menuPanel verticalLayout ifTrue:[
^ y max:(self class separatorSize:(self separatorType))
].
^ y + (menuPanel font height)
!
verticalInset
self isButton ifTrue: [^VerticalButtonInset].
^VerticalInset
!
width
"gets width
"
layout isNil ifTrue:[
^ self preferredExtentX
].
^ layout width
! !
!MenuPanel::Item methodsFor:'building'!
aspectAt:aKey
"retursns value assigned to key or nil
"
|appl value|
appl := menuPanel receiver.
(appl isKindOf:ValueModel) ifTrue:[
^ appl value:aKey
].
(appl notNil or:[(appl := menuPanel application) notNil]) ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|] do:[
(appl isKindOf:ApplicationModel) ifTrue:[value := appl aspectFor:aKey]
ifFalse:[value := appl perform:aKey]
]
].
^ value
! !
!MenuPanel::Item methodsFor:'change & update'!
enabledStateOfMenuChangedTo:aState
"enabled state of menu changed to aState
"
rawLabel notNil ifTrue:[
self drawLabel
].
!
update:something with:aParameter from:changedObject
changedObject == self indication ifTrue:[
rawLabel icon:(self indicator).
^ self redraw
].
changedObject == enableChannel ifTrue:[
(rawLabel notNil and:[menuPanel canDrawItem]) ifTrue:[
self drawLabel
].
^ self
].
super update:something with:aParameter from:changedObject
!
updateIndicators
"update indicators
"
|indicator|
(indicator := self indicator) notNil ifTrue:[
indicator = rawLabel icon ifFalse:[
rawLabel icon:indicator.
^ self redraw.
]
].
! !
!MenuPanel::Item methodsFor:'converting'!
asMenuItem
"convert to a MenuItem
"
|item label rcv|
label := self label.
item := MenuItem labeled:(label printString).
label isImage ifTrue:[
rcv := ResourceRetriever new.
rcv className:#MenuEditor.
rcv selector:#iconUnknown.
item labelImage:rcv.
].
item activeHelpKey:activeHelpKey.
enableChannel notNil ifTrue:[
item enabled:(enableChannel value)
].
item accessCharacterPosition:(self accessCharacterPosition).
item argument:(self argument).
item nameKey:(self nameKey).
item shortcutKeyCharacter:(self shortcutKey).
item value:(value value).
item indication:(self indication value).
submenuChannel isSymbol ifTrue:[
item submenuChannel:submenuChannel
] ifFalse:[
self submenu notNil ifTrue:[
item submenu:(self submenu asMenu)
]
].
^ item
!
menuItem:aMenuItem
"setup attributes from a MenuItem
"
|var lbl|
menuPanel disabledRedrawDo:[
label := nil.
activeHelpKey := aMenuItem activeHelpKey.
self enabled:(aMenuItem enabled).
self nameKey:(aMenuItem nameKey).
self indication:(aMenuItem indication).
self isButton:(aMenuItem isButton).
(lbl := aMenuItem labelImage value) isNil ifTrue:[
lbl := aMenuItem label.
].
self label:lbl.
self shortcutKey:(aMenuItem shortcutKeyCharacter).
(var := aMenuItem argument) notNil ifTrue:[
self argument:var.
].
(var := aMenuItem accessCharacterPosition) notNil ifTrue:[
self accessCharacterPosition:var.
].
submenuChannel := aMenuItem submenuChannel.
self submenu:(aMenuItem submenu).
self value:(aMenuItem value).
]
! !
!MenuPanel::Item methodsFor:'drawing'!
drawButtonFrame
"draw a Button frame around the item
"
|l t h w|
l := layout left.
t := layout top.
h := layout height.
w := layout width.
menuPanel lineWidth: 1.
menuPanel paint:Color black.
menuPanel displayRectangleX: l y: t width: w height: h.
self isSelected
ifFalse:[menuPanel paint:Color white]
ifTrue: [menuPanel paint:Color gray].
menuPanel displayLineFromX: l + 1 y: t + 1 toX: l + w - 2 y: t + 1.
menuPanel displayLineFromX: l + 1 y: t + 2 toX: l + w - 2 y: t + 2.
menuPanel displayLineFromX: l + 1 y: t + 3 toX: l + 1 y: t + h - 1.
menuPanel displayLineFromX: l + 2 y: t + 3 toX: l + 2 y: t + h - 1.
self isSelected
ifFalse: [menuPanel paint:Color gray]
ifTrue: [menuPanel paint:Color white].
menuPanel displayLineFromX: l + w - 2 y: t + 1 toX: l + w - 2 y: t + h - 1.
menuPanel displayLineFromX: l + w - 3 y: t + 2 toX: l + w - 3 y: t + h - 1.
menuPanel displayLineFromX: l + 2 y: t + h - 3 toX: l + w - 1 y: t + h - 3.
menuPanel displayLineFromX: l + 1 y: t + h - 2 toX: l + w - 1 y: t + h - 2.
!
drawLabel
"draw label
"
|y x h l t scKey cLb cLa img fg asc arrow hrzInset|
img := rawLabel.
asc := menuPanel font ascent.
h := layout height.
l := layout left.
t := layout top.
hrzInset := self horizontalInset.
self enabled ifTrue:[
fg := self isSelected ifTrue:[self activeForegroundColor]
ifFalse:[menuPanel foregroundColor].
menuPanel paint:fg
] ifFalse:[
menuPanel paint:(menuPanel disabledForegroundColor).
rawLabel isString ifFalse:[
"/ remember device image to avoid loosing colors
disabledImage isNil ifTrue:[
((img respondsTo:#colorMap) and:[img colorMap notNil]) ifTrue:[
disabledImage := img lightened onDevice:menuPanel device.
] ifFalse:[
disabledImage := img
]
].
img := disabledImage.
]
].
"/ t := t + menuPanel level.
y := t + ((h - (img heightOn:menuPanel)) // 2).
(self textLabel) notNil ifTrue:[
y := y + asc.
].
self isButton
ifTrue:
[
"menuPanel paint:menuPanel backgroundColor.
menuPanel fillRectangleX:(l + hrzInset) y:y width: (img widthOn: menuPanel) + 1height: (img heightOn: menuPanel) + 1.
"self isSelected
ifFalse:
[
img displayOn:menuPanel x:(l + hrzInset) y:y.
]
ifTrue:
[
img displayOn:menuPanel x:(l + hrzInset) + 1 y: y + 1.
].
self drawButtonFrame.
]
ifFalse:
[
img displayOn:menuPanel x:(l + hrzInset) y:y.
].
"/ DRAW SHORTCUT KEY
(scKey:= self shortcutKeyAsString) notNil ifTrue:[
(x := menuPanel shortKeyInset) == 0 ifTrue:[
x := hrzInset + LabelRightOffset + (img widthOn:menuPanel)
].
x := l + x.
y := t + ((h - (scKey heightOn:menuPanel)) // 2).
y := y + asc.
scKey displayOn:menuPanel x:x y:y.
].
"/ DRAW SUBMENU INDICATION
(menuPanel isVerticalLayout and:[self submenu notNil]) ifTrue:[
arrow := menuPanel rightArrow.
x := layout right - arrow width - hrzInset.
y := t + (h - arrow height // 2).
(img := menuPanel rightArrowShadow) isNil ifTrue:[
^ menuPanel displayForm:arrow x:x y:y
].
cLa := menuPanel shadowColor.
cLb := menuPanel lightColor.
self isSelected ifFalse:[
fg := cLa.
cLa := cLb.
cLb := fg
].
menuPanel paint:cLa.
menuPanel displayForm:arrow x:x y:y.
menuPanel paint:cLb.
menuPanel displayForm:img x:x y:y.
]
!
redraw
"redraw item
"
|isSelected ownBgCol showItemSep type x y paint h w l t r b lgCol shCol hrzInset|
menuPanel canDrawItem ifFalse:[
^ self
].
isSelected := self isSelected.
hrzInset := self horizontalInset.
isSelected ifFalse:[
paint := menuPanel backgroundColor
] ifTrue:[
paint := self activeBackgroundColor
].
l := layout left.
t := layout top.
r := layout right.
b := layout bottom.
h := layout height.
w := layout width.
(ownBgCol := self backgroundColorFromLabel) isNil ifTrue:[
menuPanel paint:paint.
menuPanel fillRectangle:layout.
] ifFalse:[
self hasIndication ifFalse:[
menuPanel paint:ownBgCol.
menuPanel fillRectangle:layout.
] ifTrue:[
menuPanel paint:paint.
x := (rawLabel icon width) + hrzInset + 4.
menuPanel fillRectangleX:l y:t width:x height:h.
menuPanel paint:ownBgCol.
menuPanel fillRectangleX:(l + x) y:t width:(w - x) height:h.
ownBgCol := nil.
].
].
lgCol := menuPanel lightColor.
shCol := menuPanel shadowColor.
showItemSep := menuPanel showSeparatingLines.
self isSeparator ifTrue:[ "/ draw item separator
( showItemSep not and:[(type := self separatorType) notNil
and:[type ~~ #blankLine]]
) ifFalse:[
^ self
].
menuPanel paint:shCol.
menuPanel verticalLayout ifTrue:[
l := l + hrzInset.
r := r - hrzInset.
y := t - 1 + (h // 2).
type == #doubleLine ifTrue:[y := y - 2].
menuPanel displayLineFromX:l y:y toX:r y:y.
menuPanel paint:lgCol.
y := y + 1.
menuPanel displayLineFromX:l y:y toX:r y:y.
type == #doubleLine ifTrue:[
y := y + 3.
menuPanel paint:shCol.
menuPanel displayLineFromX:l y:y toX:r y:y.
menuPanel paint:lgCol.
y := y + 1.
menuPanel displayLineFromX:l y:y toX:r y:y.
].
] ifFalse:[
x := l - 1 + (w // 2).
type == #doubleLine ifTrue:[x := x - 2].
menuPanel displayLineFromX:x y:t toX:x y:b.
menuPanel paint:lgCol.
x := x + 1.
menuPanel displayLineFromX:x y:t toX:x y:b.
type == #doubleLine ifTrue:[
x := x + 3.
menuPanel paint:shCol.
menuPanel displayLineFromX:x y:t toX:x y:b.
menuPanel paint:lgCol.
x := x + 1.
menuPanel displayLineFromX:x y:t toX:x y:b.
]
].
^ self
].
menuPanel drawEdgesForX:l y:t width:w height:h isSelected:isSelected.
(self isButton not and: [showItemSep]) ifTrue:[
|myIndex lastItem nextItem mayDrawInLastItemsLayout mayDrawInNextItemsLayout|
menuPanel paint:lgCol.
myIndex := menuPanel indexOf: self.
lastItem := menuPanel itemAt: myIndex - 1.
nextItem := menuPanel itemAt: myIndex + 1.
mayDrawInLastItemsLayout := lastItem isNil or: [lastItem notNil and: [lastItem isButton not]].
mayDrawInNextItemsLayout := nextItem isNil or: [nextItem notNil and: [nextItem isButton not]].
menuPanel verticalLayout ifTrue:[
mayDrawInLastItemsLayout
ifTrue:
[
menuPanel displayLineFromX:l y:b - 1 toX:r y:b - 1.
menuPanel displayLineFromX:l y:t - 1 toX:r y:t - 1.
].
mayDrawInNextItemsLayout
ifTrue:
[
menuPanel paint:shCol.
menuPanel displayLineFromX:l y:b - 2 toX:r y:b - 2.
menuPanel displayLineFromX:l y:t - 2 toX:r y:t - 2.
]
] ifFalse:[
mayDrawInLastItemsLayout
ifTrue:
[
menuPanel displayLineFromX:r - 1 y:t toX:r - 1 y:b.
menuPanel displayLineFromX:l - 1 y:t toX:l - 1 y:b
].
mayDrawInNextItemsLayout
ifTrue:
[
menuPanel paint:shCol.
menuPanel displayLineFromX:r - 2 y:t toX:r - 2 y:b.
menuPanel displayLineFromX:l - 2 y:t toX:l - 2 y:b
]
]
].
self drawLabel.
self isButton
ifFalse:
[
(ownBgCol notNil and:[self isSelected]) ifTrue:[
ownBgCol brightness > 0.5 ifTrue:[menuPanel paint:(Color black)]
ifFalse:[menuPanel paint:(Color white)].
menuPanel displayRectangleX:(l + 1) y:(t + 1) width:(w - 2) height:(h - 2).
menuPanel displayRectangleX:(l + 2) y:(t + 2) width:(w - 4) height:(h - 4).
]
]
! !
!MenuPanel::Item methodsFor:'initialization'!
destroy
"destroy submenus, remove dependencies
"
|channel|
self submenu:nil.
(self isKindOfValueHolder:enableChannel) ifTrue:[
enableChannel removeDependent:self
].
channel := self indication.
(self isKindOfValueHolder:channel) ifTrue:[
channel removeDependent:self
].
menuPanel := nil.
!
fetchImages
"fetch images
"
|img|
rawLabel isImage ifTrue:[
self indicator isNil
ifTrue: [rawLabel := rawLabel onDevice:(menuPanel device)]
ifFalse: [rawLabel := LabelAndIcon form:self indicator image:rawLabel]
] ifFalse:[
rawLabel class == LabelAndIcon ifTrue:[
img := rawLabel icon onDevice:(menuPanel device).
rawLabel icon:img.
]
]
!
in:aPanel
"create item in a menuPanel
"
menuPanel := aPanel.
! !
!MenuPanel::Item methodsFor:'private'!
activeBackgroundColor
"returns the active background color derived from menuPanel
"
^menuPanel activeBackgroundColor
!
activeForegroundColor
"returns the active foreground color derived from menuPanel
"
self isButton ifTrue: [^menuPanel foregroundColor].
^menuPanel activeForegroundColor
!
adornment
"returns adornment; if not existing yet a new instance
is created
"
adornment isNil ifTrue:[
adornment := Adornment new
].
^ adornment
!
backgroundColorFromLabel
"returns the background color derived from label or nil
"
|run|
label isText ifFalse:[^ nil ].
run := label emphasis.
run size == 0 ifTrue:[^ nil ].
run := run first.
run size == 0 ifTrue:[
(run value isColor and:[run key == #backgroundColor]) ifTrue:[
^ run value
]
] ifFalse:[
run do:[:r|
(r value isColor and:[r key == #backgroundColor]) ifTrue:[
^ r value
]
]
].
^ nil
!
findSubMenuIn:aRecv
|subm keys|
subm := nil.
aRecv notNil ifTrue:[
keys := submenuChannel keywords.
keys size == 1 ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
subm := aRecv aspectFor:submenuChannel
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
subm := aRecv perform:submenuChannel
]
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
subm := aRecv class perform:submenuChannel
]
]
] ifFalse:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
subm := aRecv perform:(keys at:1) asSymbol
with:(keys at:2) asSymbol
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
subm := aRecv class perform:(keys at:1) asSymbol
with:(keys at:2) asSymbol
]
]
]
].
^ subm
!
indicationValue
"returns indication value or nil in case of no indication
"
|indication numArgs sel recv|
(indication := self indication) isNil ifTrue:[
^ nil "/ has no indication
].
indication isSymbol ifTrue:[
(numArgs := indication numArgs) ~~ 0 ifTrue:[
numArgs == 2 ifTrue:[
recv := menuPanel receiver.
(recv isKindOf:ValueModel) ifFalse:[
(recv notNil or:[(recv := menuPanel application) notNil]) ifTrue:[
sel := indication copyFrom:1 to:(indication indexOf:$:).
indication := nil.
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
indication := recv perform:(sel asSymbol) with:self argument
]
].
].
^ indication value == true
].
indication := (indication copyWithoutLast:1) asSymbol
].
indication := self aspectAt:indication.
(self isKindOfValueHolder:indication) ifTrue:[
self adornment indication:indication.
indication addDependent:self.
]
].
^ indication value == true
!
indicationValue:aValue
"returns indication value or nil
"
|numArgs indication recv|
(indication := self indication) isNil ifTrue:[
^ self "/ has no indication
].
indication isSymbol ifFalse:[
(self isKindOfValueHolder:indication) ifTrue:[ "/ is value holder
indication value:aValue
].
^ self
].
recv := menuPanel receiver.
(recv isKindOf:ValueModel) ifTrue:[
recv value:indication value:aValue.
] ifFalse:[
( (numArgs := indication numArgs) ~~ 0
and:[recv notNil or:[(recv := menuPanel application) notNil]]
) ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex| ] do:[
numArgs == 1 ifTrue:[
recv perform:indication with:aValue
] ifFalse:[
recv perform:indication with:self argument with:aValue
]
]
]
].
!
indicator
"returns indication form or nil
"
|value|
(value := self indicationValue) isNil ifTrue:[
^ nil
].
^ value ifTrue:[IndicatorOn] ifFalse:[IndicatorOff]
!
separatorType
"returns type of separator line or nil
"
|c lbl|
rawLabel isNil ifFalse:[
^ nil
].
(lbl := label value) isNil ifTrue:[
^ #singleLine
].
lbl size == 1 ifTrue:[
c := lbl first.
c == $- ifTrue:[^ #singleLine].
c == $= ifTrue:[^ #doubleLine].
].
^ #blankLine
!
updateRawLabel
"recreate rawLabel
"
|char size indicator|
(rawLabel := label value) isString ifFalse:[
^ menuPanel mustRearrange.
].
rawLabel isText ifFalse:[
rawLabel := rawLabel withoutSeparators
].
size := rawLabel size.
(indicator := self indicator) isNil ifTrue:[
size == 0 ifTrue:[
rawLabel := nil.
^ menuPanel mustRearrange
].
size == 1 ifTrue:[
char := rawLabel first.
(char == $- or:[char == $=]) ifTrue:[ "/ other line separators
label := String new:1.
label at:1 put:char.
rawLabel := nil.
^ menuPanel mustRearrange
]
]
] ifFalse:[
size == 0 ifTrue:[rawLabel := label value]
].
size := self accessCharacterPosition.
(size notNil and:[size <= rawLabel size]) ifTrue:[
rawLabel isText ifFalse:[
rawLabel := Text string:rawLabel
].
rawLabel emphasisAt:size add:#underline
].
(indicator := self indicator) notNil ifTrue:[
rawLabel := LabelAndIcon icon:indicator string:rawLabel.
].
menuPanel mustRearrange.
! !
!MenuPanel::Item methodsFor:'queries'!
canSelect
"returns true if item is selectable
"
^ (self enabled and:[rawLabel notNil])
!
containsPointX:x y:y
"returns true if point is contained in my layout
"
layout isNil ifFalse:[
^ ( (x >= layout left)
and:[x < layout right
and:[y > layout top
and:[y <= layout bottom]]]
)
].
^ false
!
hasIndication
"returns true if on/off indication exists
"
^ self indication notNil
!
hasSubmenu
"returns true if a submenu exists
"
^ self submenu notNil
!
isEnabled
"returns enabled state
"
^ self enabled
!
isKindOfValueHolder:something
"returns true if something is kind of vlaue holder
"
^ ((something respondsTo:#value:) and:[something isBlock not])
!
isSeparator
"returns true if item is a separator
"
^ rawLabel isNil
!
shortcutKeyAsString
"converts shortcutKey to a text object
"
|nm key|
"/ this is somewhat complicated: we have the symbolic key at hand,
"/ but want to show the untranslated (inverse keyBoardMapped) key & modifier
"/
(key := self shortcutKey) isNil ifTrue:[
^ nil
].
key isCharacter ifTrue:[
nm := key asString
] ifFalse:[
nm := menuPanel device keyboardMap keyAtValue:key ifAbsent:key.
"/
"/ some modifier-key combination ?
"/
(nm startsWith:#Cmd) ifTrue:[
nm := (self shortcutKeyPrefixFor:#Cmd) , (nm copyFrom:4)
] ifFalse:[(nm startsWith:#Alt) ifTrue:[
nm := (self shortcutKeyPrefixFor:#Alt) , (nm copyFrom:4)
] ifFalse:[(nm startsWith:#Meta) ifTrue:[
nm := (self shortcutKeyPrefixFor:#Meta), (nm copyFrom:5)
]
ifFalse:[(nm startsWith:#Ctrl) ifTrue:[
nm := (self shortcutKeyPrefixFor:#Ctrl), (nm copyFrom:5)
] ifFalse:[
nm := nm asString
]]]]
].
^ nm
!
shortcutKeyPrefixFor:aModifier
"returns prefix assigned to a modifier
"
|m|
m := menuPanel device modifierKeyTopFor:aModifier.
m notNil ifTrue:[
^ m , '-'
].
^ aModifier.
! !
!MenuPanel::Item methodsFor:'selection'!
hideSubmenu
"hide submenu
"
|subMenu id|
subMenu := self submenu.
subMenu realized ifFalse:[
(id := subMenu id) notNil ifTrue:[
menuPanel device unmapWindow:id
]
] ifTrue:[
subMenu hide
]
"Modified: / 27.10.1997 / 04:13:13 / cg"
!
isSelected
"returns true if item is selected
"
^ menuPanel selection == self
!
openSubmenuAt:aPoint
"open submenu at a point
"
|top windowGrp subMenu|
windowGrp := menuPanel topMenu windowGroup.
subMenu := self setupSubmenu.
windowGrp notNil ifTrue:[
subMenu windowGroup:windowGrp.
windowGrp addTopView:subMenu.
].
subMenu fixSize.
subMenu origin:aPoint.
subMenu makeFullyVisible.
top := menuPanel topMenu.
subMenu realized ifFalse:[
subMenu realize.
] ifTrue:[
top device mapWindow:subMenu id.
].
"/ (top styleSheet at:'menu.autoSelectFirst') ifTrue:[
"/ subMenu selectionIndex:1
"/ ]
!
selected:aState
"change selection to a state. Dependant on the state open or hide an existing
submenu and perform a redraw
"
|p d subMenu|
subMenu := self submenu.
aState ifFalse:[
self redraw.
subMenu notNil ifTrue:[
self hideSubmenu
].
^ self
].
menuPanel shown ifFalse:[^ self].
self redraw.
subMenu isNil ifTrue:[
^ menuPanel grabMouseAndKeyboard
].
menuPanel verticalLayout ifTrue:[p := (layout right) @ (layout top)]
ifFalse:[p := (layout left) @ (layout bottom)].
d := menuPanel device.
p := d translatePoint:p from:(menuPanel id) to:(d rootWindowId).
self openSubmenuAt:p.
! !
!MenuPanel::Item::Adornment methodsFor:'accessing'!
accessCharacterPosition
"get the index of the access character in the label text or string, or nil if none
"
^ accessCharacterPosition
!
accessCharacterPosition:anIndexOrNil
"set the index of the access character in the label text or string, or nil if none
"
accessCharacterPosition := anIndexOrNil
!
argument
"ST/X goody; get argunment to a selector or block
"
^ argument
!
argument:anArgumentOrNil
"ST/X goody; set argunment to a selector or block
"
argument := anArgumentOrNil
!
indication
"get has on/off indicator value
"
^ indication
!
indication:something
"set has on/off indicator value
"
indication := something.
!
shortcutKey
"get the character that is used as a shortcut key for this item
"
^ shortcutKey
!
shortcutKey:aKeyOrNil
"set the character that is used as a shortcut key for this item
"
shortcutKey := aKeyOrNil
! !
!MenuPanel class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.53 1998-01-27 14:45:29 ca Exp $'
! !
MenuPanel initialize!