"
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
selectionFrameBrightColor selectionFrameDarkColor
buttonLightColor buttonShadowColor buttonHalfLightColor
buttonHalfShadowColor enteredItem buttonEnteredBgColor
prevFocusView previousPointerGrab previousKeyboardGrab
relativeGrabOrigin hasImplicitGrap iconIndicationOff
iconIndicationOn iconRadioGroupOff iconRadioGroupOn'
classVariableNames:'InitialSelectionQuerySignal DefaultAdornment ShortcutKeyOffset
DefaultGroupDividerSize DefaultHilightLevel DefaultLevel
DefaultItemSpace DefaultButtonItemSpace DefaultForegroundColor
DefaultBackgroundColor DefaultHilightForegroundColor
DefaultHilightBackgroundColor DefaultDisabledForegroundColor
DefaultEnteredLevel DefaultSelectionFollowsMouse
DefaultFitFirstPanel RightArrowForm RightArrowShadowForm
SelectionFrameBrightColor SelectionFrameDarkColor
ButtonActiveLevel ButtonPassiveLevel ButtonActiveBackgroundColor
ButtonPassiveBackgroundColor ButtonLightColor ButtonShadowColor
ButtonHalfLightColor ButtonHalfShadowColor ButtonEdgeStyle Images
LigthenedImages ButtonEnteredBackgroundColor ButtonEnteredLevel'
poolDictionaries:''
category:'Views-Menus'
!
Object subclass:#Item
instanceVariableNames:'layout menuPanel subMenu rawLabel rawLabelExtent disabledRawLabel
enableChannel nameKey value label activeHelpKey activeHelpText
submenuChannel startGroup isButton isVisible hideMenuOnActivated
indication accessCharacterPosition shortcutKey argument choice
choiceValue showBusyCursorWhilePerforming accessCharacter'
classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
VerticalButtonInset LabelRightOffset'
poolDictionaries:''
privateIn:MenuPanel
!
!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"
!
preSnapshot
"remove all resources
"
Images := nil.
LigthenedImages := nil.
! !
!MenuPanel class methodsFor:'default icons'!
iconIndicationOff
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self iconIndicationOff inspect
ImageEditor openOnClass:self andSelector:#iconIndicationOff
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconIndicationOff'
ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUPG???8A0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@Z*** @@@@@@b') ; colorMapFromArray:#[255 255 255 127 127 127 170 170 170 0 0 0]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]!
iconIndicationOn
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self iconIndicationOn inspect
ImageEditor openOnClass:self andSelector:#iconIndicationOn
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconIndicationOn'
ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'****$H@@@MBEUUWP!!UUU4HUUT]BEUTGP!!ETA4HPTA]BD@AWP!!PAU4HUAU]BEUUWP/???4EUUUU@b') ; colorMapFromArray:#[0 0 0 255 255 255 127 127 127 170 170 170]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]!
iconRadioGroupOff
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self iconRadioGroupOff inspect
ImageEditor openOnClass:self andSelector:#iconRadioGroupOff
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconRadioGroupOff'
ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D_?>(AO??;AO???LS???3D???<1O???LS???3A_??3@Z??<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]!
iconRadioGroupOn
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self iconRadioGroupOn inspect
ImageEditor openOnClass:self andSelector:#iconRadioGroupOn
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconRadioGroupOn'
ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D]@^(AL@@;AM@@GLS@@@3D0@@L1L@@CLSP@A3A\@@3@Z4A<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]! !
!MenuPanel class methodsFor:'defaults'!
updateStyleCache
<resource: #style (#'menu.foregroundColor' #'menu.backgroundColor'
#'menu.hilightForegroundColor' #'menu.disabledForegroundColor'
#'menu.hilightBackgroundColor' #'menu.buttonEnteredBackgroundColor'
#'menu.hilightLevel' #'menu.groupDividerSize'
#'menu.itemSpace' #'menu.buttonItemSpace'
#'menu.fitFirstPanel' #'menu.buttonActiveLevel'
#'menu.buttonPassiveLevel' #'menu.buttonEnteredLevel'
#'menu.selectionFollowsMouse' #'menu.enteredLevel'
#'viewBackground'
#'pullDownMenu.level' #'pullDownMenu.hilightLevel'
#'button.disabledForegroundColor' #'button.enteredBackgroundColor'
#'button.activeBackgroundColor' #'button.backgroundColor'
#'button.lightColor' #'button.shadowColor'
#'button.halfLightColor' #'button.halfShadowColor'
#'button.passiveLevel' #'button.activeLevel'
#'button.edgeStyle')>
|style styleSheet|
styleSheet := StyleSheet.
style := styleSheet name.
DefaultForegroundColor := styleSheet colorAt:#'menu.foregroundColor'
default:Color black.
DefaultBackgroundColor := styleSheet colorAt:#'menu.backgroundColor'
default:DefaultViewBackgroundColor.
DefaultHilightForegroundColor := styleSheet colorAt:#'menu.hilightForegroundColor'.
DefaultHilightForegroundColor isNil ifTrue:[
styleSheet is3D ifTrue:[
DefaultHilightForegroundColor := DefaultForegroundColor.
] ifFalse:[
DefaultHilightForegroundColor := DefaultBackgroundColor.
].
].
DefaultDisabledForegroundColor := styleSheet colorAt:#'menu.disabledForegroundColor'.
DefaultDisabledForegroundColor isNil ifTrue:[
DefaultDisabledForegroundColor := styleSheet colorAt:#'button.disabledForegroundColor'
default:Color darkGray.
].
DefaultHilightBackgroundColor := styleSheet colorAt:#'menu.hilightBackgroundColor'.
DefaultHilightBackgroundColor isNil ifTrue:[
style == #motif ifTrue:[
DefaultHilightBackgroundColor := DefaultBackgroundColor
] ifFalse:[
DefaultHilightBackgroundColor := styleSheet is3D ifFalse:[DefaultForegroundColor]
ifTrue:[DefaultBackgroundColor]
]
].
DefaultLevel := styleSheet at:#'pullDownMenu.level' default:0.
(style == #motif or:[style == #iris]) ifTrue:[
DefaultHilightLevel := 2.
DefaultLevel := DefaultLevel + 1.
] ifFalse:[
(DefaultHilightLevel := styleSheet at:'pullDownMenu.hilightLevel') isNil ifTrue:[
DefaultHilightLevel := styleSheet at:'menu.hilightLevel' default:0.
].
styleSheet is3D ifTrue:[DefaultLevel := DefaultLevel + 1].
].
DefaultGroupDividerSize := styleSheet at:#'menu.groupDividerSize' default:6.
DefaultItemSpace := styleSheet at:#'menu.itemSpace' default:2.
DefaultButtonItemSpace := styleSheet at:#'menu.buttonItemSpace' default:0.
DefaultFitFirstPanel := styleSheet at:#'menu.fitFirstPanel' default:true.
MenuView updateStyleCache.
DefaultFont := MenuView defaultFont.
RightArrowForm := SelectionInListView rightArrowFormOn:Display.
(style ~~ #os2 and:[style ~~ #win95]) ifTrue:[
RightArrowShadowForm := SelectionInListView rightArrowShadowFormOn:Display.
] ifFalse:[
RightArrowShadowForm := nil
].
SelectionFrameBrightColor := Color white.
SelectionFrameDarkColor := Color black.
ButtonActiveLevel := styleSheet at:#'menu.buttonActiveLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]).
ButtonActiveLevel isNil ifTrue:[
ButtonActiveLevel := styleSheet at:#'button.activeLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]).
].
ButtonPassiveLevel := styleSheet at:#'menu.buttonPassiveLevel'.
ButtonPassiveLevel isNil ifTrue:[
ButtonPassiveLevel := styleSheet at:#'button.passiveLevel' default:(styleSheet is3D ifTrue:[2] ifFalse:[0]).
].
ButtonActiveBackgroundColor := styleSheet at:#'button.activeBackgroundColor' default: DefaultBackgroundColor.
ButtonPassiveBackgroundColor := (styleSheet at:#'button.backgroundColor') ? (styleSheet at:'viewBackground') ? DefaultBackgroundColor.
ButtonLightColor := styleSheet at:#'button.lightColor'.
ButtonLightColor isNil ifTrue:[
ButtonLightColor := (ButtonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) lightened. "/ Color white
].
ButtonShadowColor := styleSheet at:#'button.shadowColor'.
ButtonShadowColor isNil ifTrue:[
ButtonShadowColor := (ButtonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) darkened. "/ Color white
].
ButtonHalfLightColor := styleSheet at:#'button.halfLightColor'.
ButtonHalfShadowColor := styleSheet at:#'button.halfShadowColor'.
ButtonEdgeStyle := styleSheet at:#'button.edgeStyle'.
ButtonEnteredBackgroundColor := styleSheet colorAt:#'menu.buttonEnteredBackgroundColor'.
ButtonEnteredBackgroundColor isNil ifTrue:[
ButtonEnteredBackgroundColor := styleSheet colorAt:#'button.enteredBackgroundColor'
default:ButtonPassiveBackgroundColor.
].
ButtonEnteredLevel := styleSheet at:#'menu.buttonEnteredLevel' default:ButtonPassiveLevel.
DefaultSelectionFollowsMouse := styleSheet at:#'menu.selectionFollowsMouse' default:false.
DefaultEnteredLevel := styleSheet at:#'menu.enteredLevel' default:0.
ShortcutKeyOffset := 5.
Item updateStyleCache
"
self updateStyleCache
"
"Modified: / 10.9.1998 / 21:40:32 / cg"
! !
!MenuPanel class methodsFor:'image registration'!
image:anImage onDevice:aDevice
"
Images := nil
"
|deviceImages image|
anImage device == aDevice ifTrue:[
^ anImage
].
Images isNil ifTrue:[ Images := IdentityDictionary new ].
(deviceImages := Images at:aDevice ifAbsent:nil) isNil ifTrue:[
Images at:aDevice put:(deviceImages := Dictionary new)
].
(image := deviceImages at:anImage ifAbsent:nil) notNil ifTrue:[
^ image
].
image := anImage copy onDevice:aDevice.
image clearMaskedPixels.
deviceImages at:anImage put:image.
^ image
"Modified: / 29.9.1998 / 12:02:41 / cg"
!
lightenedImage:anImage onDevice:aDevice
"
LigthenedImages := nil
"
|deviceImages image|
LigthenedImages isNil ifTrue:[ LigthenedImages := IdentityDictionary new ].
(deviceImages := LigthenedImages at:aDevice ifAbsent:nil) isNil ifTrue:[
LigthenedImages at:aDevice put:(deviceImages := Dictionary new)
].
(image := deviceImages at:anImage ifAbsent:nil) notNil ifTrue:[
^ image
].
((anImage respondsTo:#colorMap) and:[anImage colorMap notNil]) ifTrue:[
image := anImage copy lightened onDevice:aDevice.
image clearMaskedPixels.
] ifFalse:[
image := self image:anImage onDevice:aDevice
].
deviceImages at:anImage put:image.
^ image
! !
!MenuPanel class methodsFor:'private'!
subMenu:aSubMenu
"create a submenu; can be redifined in derived classes
"
^ (self new) menu:aSubMenu.
"Modified: / 8.8.1998 / 02:13:11 / cg"
! !
!MenuPanel methodsFor:'accept'!
accept
"accept current selected item
"
^ self acceptItem:(self selection) inMenu:self
!
accept:anItem
"this is the topMenu: accept item
"
|value item tgState itemIdx recv panel masterGroup winGrp|
self superMenu notNil ifTrue:[
^ self topMenu accept:anItem
].
self selection:nil.
(anItem notNil and:[anItem canAccept]) ifTrue:[
tgState := anItem toggleIndication.
panel := anItem menuPanel.
itemIdx := panel findFirst:[:el| el == anItem ].
item := anItem.
recv := panel receiver.
].
self doUngrab:true.
self isPopUpView ifFalse:[
self do:[:el| el updateIndicators].
self windowGroup processExposeEvents.
] ifTrue:[
self unmap.
(winGrp := self windowGroup) notNil ifTrue:[
"/ give expose event a chance to arrive
[shown and:[realized]] whileTrue:[
winGrp processExposeEventsFor:self
].
masterGroup := winGrp previousGroup.
].
self destroy.
masterGroup notNil ifTrue:[masterGroup processExposeEvents].
].
(item notNil
and:[item showBusyCursorWhilePerforming
and:[(winGrp := (masterGroup ? (self windowGroup))) notNil]])
ifTrue:[
winGrp withWaitCursorDo:[
value := self accept:item index:itemIdx toggle:tgState receiver:recv.
]
] ifFalse:[
value := self accept:item index:itemIdx toggle:tgState receiver:recv.
].
self isPopUpView ifTrue:[
self menuAdornmentAt:#value put:value.
self menuAdornmentAt:#item put:item.
].
^ item.
"Modified: / 22.2.1999 / 20:14:48 / cg"
!
accept:anItem index:anIndex toggle:aState receiver:aReceiver
"accept an item
"
|value argument numArgs isKindOfValueModel rec args arg2
app master fallBack|
anItem isNil ifTrue:[
self menuAdornmentAt:#hasPerformed put:true.
^ nil
].
self menuAdornmentAt:#hasPerformed put:(aReceiver isValueModel).
(value := anItem value) isNil ifTrue:[
^ anIndex
].
(argument := anItem argument) isNil ifTrue:[
argument := aState ? anItem
].
value isSymbol ifFalse:[
"/ a valueHolder or block
numArgs := value perform:#numArgs ifNotUnderstood:0.
numArgs == 0 ifTrue:[
args := nil
] ifFalse:[
numArgs == 1 ifTrue:[
args := Array with:argument
] ifFalse:[
args := Array with:argument with:self
]
].
value valueWithArguments:args.
self menuAdornmentAt:#hasPerformed put:true.
^ anIndex
].
aReceiver isNil ifTrue:[
^ value
].
isKindOfValueModel := aReceiver isValueModel.
isKindOfValueModel ifTrue:[
aReceiver value:value
] ifFalse:[
rec := aReceiver.
arg2 := self.
"/ support for ST80 style applications
"/ (expecting the message to go to the application
"/ if not understood by the view)
"/ These expect the controller to be passed as argument.
"/ sigh.
(aReceiver isView
and:[(aReceiver respondsTo:value) not
and:[(app := aReceiver application) ~~ aReceiver
and:[app notNil]]]) ifTrue:[
rec := app.
arg2 := aReceiver controller "/ the Views controller
].
(numArgs := value numArgs) == 0 ifTrue:[
args := nil
] ifFalse:[
numArgs == 1 ifTrue:[
args := Array with:argument
] ifFalse:[
args := Array with:argument with:arg2
]
].
fallBack :=
[
"/ mhmh - the receiver did not respond to that message;
"/ if there is a master-application, try that one
"/ (recursive)
master := rec perform:#masterApplication ifNotUnderstood:nil.
master notNil ifTrue:[
rec := master.
rec perform:value withArguments:args ifNotUnderstood:fallBack
] ifFalse:[
self
error:'unimplemented menu message: ' , value
mayProceed:true
].
].
rec perform:value withArguments:args ifNotUnderstood:fallBack.
].
self menuAdornmentAt:#hasPerformed put:true.
^ value
"Modified: / 19.2.2000 / 11:08:22 / cg"
!
acceptItem:anItem inMenu:aMenu
|tgState|
(anItem isNil or:[anItem hideMenuOnActivated or:[aMenu isPopUpView not]]) ifTrue:[
self topMenu accept:anItem
] ifFalse:[
anItem canAccept ifTrue:[
tgState := anItem toggleIndication.
self accept:anItem
index:(aMenu selectionIndex)
toggle:tgState
receiver:(aMenu receiver).
aMenu do:[:el| el updateIndicators].
]
]
!
lastItemAccepted
"returns last item selected or nil
"
^ self topMenu menuAdornmentAt:#item
!
lastValueAccepted
"returns last value accepted or nil
"
^ (self lastItemAccepted) value
"/ |top|
"/
"/ top := self topMenu.
"/
"/ (top menuAdornmentAt:#hasPerformed) == true ifTrue:[
"/ ^ self topMenu menuAdornmentAt:#value.
"/ ].
"/ ^ nil
"Modified: / 18.6.1998 / 23:37:09 / cg"
! !
!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 ]
!
enteredItem
"return the item over which the mouse pointer is located;
nil if the mouse is not over any item"
^ enteredItem
"Created: / 20.8.1998 / 13:12:34 / cg"
!
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'!
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 ].
!
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.
enabled ~~ state ifTrue:[
enabled := state.
self invalidate.
].
!
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
!
activeForegroundColor
"get the foreground color used to highlight selections
"
^ activeFgColor
!
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 "/ RepairNow:true
]
]
"Modified: / 6.6.1998 / 19:50:06 / cg"
!
buttonActiveBackgroundColor
"get the background drawing color used to highlight button selection
"
^ButtonActiveBackgroundColor
!
buttonEdgeStyle
"get the button edge style
"
^ButtonEdgeStyle
!
buttonEnteredBackgroundColor
"get the background drawing color used to highlight entered button items
"
^ buttonEnteredBgColor
"Created: / 20.8.1998 / 13:53:37 / cg"
!
buttonEnteredLevel
"get the 3D-level used to highlight entered button items
"
^ ButtonEnteredLevel
"Created: / 20.8.1998 / 13:53:46 / cg"
"Modified: / 20.8.1998 / 15:49:32 / cg"
!
buttonHalfLightColor
"get the background drawing color used to half light button frame
"
^buttonHalfLightColor
!
buttonHalfShadowColor
"get the background drawing color used to half shadow button frame
"
^buttonHalfShadowColor
!
buttonLightColor
"get the background drawing color used to light button frame
"
^buttonLightColor
!
buttonPassiveBackgroundColor
"get the background drawing color used for button
"
^ButtonPassiveBackgroundColor
!
buttonShadowColor
"get the background drawing color used to shadow button frame
"
^buttonShadowColor
!
disabledForegroundColor
"return the foreground color used by disabled items
"
^ disabledFgColor
!
font:aFont
"set the font
"
(aFont notNil and:[aFont ~= font]) ifTrue:[
super font:(aFont onDevice:device).
superMenu notNil ifTrue:[
self extent:(self preferredExtent)
].
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 onDevice:device.
shown ifTrue:[
self invalidate "/ RepairNow:true
]
]
"Modified: / 6.6.1998 / 19:50:46 / cg"
!
lightColor
"get the lightColor
"
^ lightColor
!
maxAbsoluteButtonLevel
"returns the maximum absolute button level; used to compute the preferred
extent of a button
"
|level|
level := (ButtonActiveLevel abs) max:(ButtonEnteredLevel abs).
^ level max:(ButtonPassiveLevel abs)
!
selectionFrameBrightColor
"get the selection frame bright color
"
^selectionFrameBrightColor
!
selectionFrameDarkColor
"get the selection frame dark color
"
^selectionFrameDarkColor
!
shadowColor
"get the shadowColor
"
^ shadowColor
! !
!MenuPanel methodsFor:'accessing-dimensions'!
height
"default height
"
|item|
(explicitExtent ~~ true) ifTrue:[
^ self preferredExtent y
].
^ super height
!
preferredExtent
"compute and returns my preferred extent
!!!!!! changes have influence on method #rearrangeItems !!!!!!
"
|hasMenu shCtKey extent showAcc sck
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
elY "{ Class:SmallInteger }"
space "{ Class:SmallInteger }"
hrzInset "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
buttonInset "{ Class:SmallInteger }"
labelInset "{ Class:SmallInteger }"
|
(size := items size) == 0 ifTrue:[
^ 32 @ 32
].
buttonInset := 2 * (DefaultButtonItemSpace abs).
self isPopUpView ifFalse:[
labelInset := 2 * (DefaultEnteredLevel abs).
] ifTrue:[
labelInset := 0.
].
x := 0.
y := 0.
self verticalLayout ifFalse:[
"/ HORIZONTAL LAYOUT
items keysAndValuesDo:[:key :el| |eX eY|
extent := el preferredExtent.
"/ check for visibility (extent x ~~ 0)
(eX := extent x) ~~ 0 ifTrue:[
eY := extent y.
el isButton ifTrue:[
eX := eX + buttonInset.
eY := eY + buttonInset.
] ifFalse:[
eX := eX + labelInset.
eY := eY + labelInset.
].
key ~~ size ifTrue:[
(self hasGroupDividerAt:key) ifTrue:[
x := x + groupDividerSize
] ifFalse:[
el isLabeledItem ifTrue:[
x := x + itemSpace
]
]
].
x := eX + x.
y := eY max:y.
]
]
] ifTrue:[
hasMenu := false.
shCtKey := 0.
showAcc := MenuView showAcceleratorKeys == true.
y := x.
x := 0.
items keysAndValuesDo:[:key :el| |eX eY|
extent := el preferredExtent.
"/ check for visibility (extent x ~~ 0)
(eX := extent x) ~~ 0 ifTrue:[
eY := extent y.
el isButton ifTrue:[
eX := eX + buttonInset.
eY := eY + buttonInset.
] ifFalse:[
eX := eX + labelInset.
eY := eY + labelInset.
].
hasMenu ifFalse:[
hasMenu := el hasSubmenu
].
(showAcc and:[(sck := el shortcutKeyAsString) notNil]) ifTrue:[
shCtKey := shCtKey max:(sck widthOn:self)
].
key ~~ size ifTrue:[
(self hasGroupDividerAt:key) ifTrue:[
y := y + groupDividerSize
"/ ] ifFalse:[
"/ y := y + itemSpace
]
].
y := eY + y.
x := eX max:x.
].
].
(hasMenu or:[shCtKey ~~ 0]) ifTrue:[
shortKeyInset := x + Item labelRightOffset.
x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
(shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
x := x + ShortcutKeyOffset
]
].
"/ to have a small inset
y := y + 1.
"/ x := x + 1.
].
x := x + margin + margin.
y := y + margin + margin.
^ x @ y
!
shortKeyInset
"left inset of shortcutKey
"
^ shortKeyInset
!
subMenuIndicationWidth
^ RightArrowForm width
! !
!MenuPanel methodsFor:'accessing-interactors'!
iconIndicationOff
iconIndicationOff isNil ifTrue:[
superMenu notNil ifTrue:[
iconIndicationOff := superMenu iconIndicationOff
] ifFalse:[
iconIndicationOff := self registerImageOnDevice:(self class iconIndicationOff)
].
].
^ iconIndicationOff
!
iconIndicationOn
iconIndicationOn isNil ifTrue:[
superMenu notNil ifTrue:[
iconIndicationOn := superMenu iconIndicationOn
] ifFalse:[
iconIndicationOn := self registerImageOnDevice:(self class iconIndicationOn)
].
].
^ iconIndicationOn
!
iconRadioGroupOff
iconRadioGroupOff isNil ifTrue:[
superMenu notNil ifTrue:[
iconRadioGroupOff := superMenu iconRadioGroupOff
] ifFalse:[
iconRadioGroupOff := self registerImageOnDevice:(self class iconRadioGroupOff)
].
].
^ iconRadioGroupOff
!
iconRadioGroupOn
iconRadioGroupOn isNil ifTrue:[
superMenu notNil ifTrue:[
iconRadioGroupOn := superMenu iconRadioGroupOn
] ifFalse:[
iconRadioGroupOn := self registerImageOnDevice:(self class iconRadioGroupOn)
].
].
^ iconRadioGroupOn
! !
!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
!
itemAtIndex:anIndex
"returns item at an index or nil
"
^ items notNil ifTrue:[items at:anIndex ifAbsent:nil] ifFalse:[nil]
!
items
"returns list of items or nil
"
^ items
! !
!MenuPanel methodsFor:'accessing-look'!
buttonActiveLevel
"get the button active level
"
^ButtonActiveLevel
!
buttonPassiveLevel
"get the button passive level
"
^ButtonPassiveLevel
!
fitFirstPanel
"gets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
NOT SUPPORTED
"
^ fitFirstPanel
!
fitFirstPanel:aState
"sets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
NOT SUPPORTED
"
fitFirstPanel := aState.
!
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
].
!
level:anInt
super level:anInt.
mustRearrange := true
!
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 )
"
superMenu notNil ifTrue:[^ true].
^ (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 / deactivation'!
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; return nil if no item was selected,
or if I have already performed.
Return the items value, otherwise.
Notice, that this is returned back to the one who started this
menu (i.e. the view or controller), which will perform the action
if a non-nil is returned.
"
self rearrangeItemsIfItemVisibilityChanged.
aBoolean ifTrue:[
self fixSize.
].
self origin:aPoint.
"/ self makeFullyVisible. -- done in realize
self openModal:[true]. "realize "
"/ if I have already performed,
"/ return nil - to avoid items triggering twice.
(self topMenu menuAdornmentAt:#hasPerformed) == true ifTrue:[
^ nil
].
^ self lastValueAccepted
"Modified: / 15.9.1998 / 12:50:23 / cg"
!
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))
"Modified: / 15.9.1998 / 12:45:50 / cg"
!
startUp
"realize the menu at the current pointer position
"
^ self showAtPointer
!
startUpAt:aPoint
"realize the menu at aPoint
"
^ self showAt:aPoint
"Created: / 21.5.1998 / 14:15:57 / cg"
! !
!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
] ifFalse:[
items := items asOrderedCollection
].
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
"
self disabledRedrawDo:[
|menu newItems|
self removeAll.
(menu := aMenu) notNil ifTrue:[
(aMenu isCollection) ifTrue:[
menu := Menu new.
menu fromLiteralArrayEncoding:aMenu.
] ifFalse:[
menu receiver notNil ifTrue:[receiver := menu receiver]
].
(newItems := menu menuItems) size > 0 ifTrue:[
items := newItems collect:[:ni |
|i|
i:= Item in:self.
i menuItem:ni.
i.
].
].
self groupSizes:(menu groupSizes).
]
]
"Modified: / 8.8.1998 / 02:05:04 / cg"
! !
!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
!
drawButtonEdgesFor:anItem level:aLevel
|layout|
aLevel ~~ 0 ifTrue:[
layout := anItem layout.
styleSheet is3D ifFalse:[
self displayRectangle:layout.
] ifTrue:[
self drawEdgesForX:(layout left)
y:(layout top)
width:(layout width)
height:(layout height)
level:aLevel
shadow:buttonShadowColor
light:buttonLightColor
halfShadow:buttonHalfShadowColor
halfLight:buttonHalfLightColor
style:ButtonEdgeStyle
]
]
!
drawLabelEdgeFor:anItem selected:isSelected
|level layout|
isSelected ifTrue:[
level := onLevel
] ifFalse:[
anItem == enteredItem ifTrue:[
level := DefaultEnteredLevel
] ifFalse:[
level := offLevel
]
].
level ~~ 0 ifTrue:[
layout := anItem layout.
self drawEdgesForX:(layout left)
y:(layout top)
width:(layout width)
height:(layout height)
level:level
].
!
invalidateItem:anItem repairNow:aBool
"an item changed; invalidate the items layout
"
(mustRearrange not and:[shown]) ifTrue:[
self invalidate:(anItem layout copy) repairNow:aBool
].
!
mustRearrange
"force rearrange (i.e. set the rearrange flag)
"
mustRearrange == true ifFalse:[
mustRearrange := true.
shown ifTrue:[
self invalidate "/ RepairNow:true
]
]
"Modified: / 6.6.1998 / 19:51:07 / cg"
!
rearrangeGroups
"implements the groupIdentifier #right in a horizontal menu
"
|layout point
dltX "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
|
(self isPopUpView or:[self verticalLayout]) ifTrue:[
^ self
].
layout := items last layout.
(dltX := width - margin - layout right) <= 0 ifTrue:[
^ self "/ no free space
].
start := items findFirst:[:anItem| anItem startGroup == #right ].
start == 0 ifTrue:[
^ self "/ no item detected
].
point := dltX @ 0.
"/ move items layout to right
items from:start do:[:anItem|
anItem isVisible ifTrue:[
anItem layout moveBy:point.
]
].
!
rearrangeItems
"recompute the layout of each item
!!!!!! changes have influence on method #preferredExtent !!!!!!
"
|isVertical extent
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
inset "{ Class:SmallInteger }"
labelInset "{ Class:SmallInteger }"
buttonInset "{ Class:SmallInteger }"
|
(mustRearrange and:[(size := items size) ~~ 0]) ifFalse:[
mustRearrange := false.
^ self
].
isVertical := self verticalLayout.
buttonInset := DefaultButtonItemSpace abs.
self isPopUpView ifFalse:[
labelInset := DefaultEnteredLevel abs.
] ifTrue:[
labelInset := 0
].
(self isPopUpView or:[explicitExtent ~~ true]) ifTrue:[
extent := self preferredExtent copy.
self isPopUpView ifFalse:[
isVertical ifTrue:[extent y:1.0] ifFalse:[extent x:1.0]
].
self extent:extent
] ifFalse:[
extent := self computeExtent
].
x := y := margin.
isVertical ifFalse:[
y0 := margin.
y1 := extent y - margin.
items keysAndValuesDo:[:anIndex :el|
el isVisible ifFalse:[
el layout:(Rectangle left:x top:y0 right:x bottom:y1)
] ifTrue:[
el isButton ifTrue:[
inset := DefaultButtonItemSpace
] ifFalse:[
inset := labelInset
].
x0 := x + inset.
x1 := x0 + el preferredExtent x.
el layout:(Rectangle left:x0 top:(y0 + inset) right:x1 bottom:(y1 - inset)).
x := x1 + inset.
size ~~ anIndex ifTrue:[
(self hasGroupDividerAt:anIndex) ifTrue:[
x := x + groupDividerSize
] ifFalse:[
el isLabeledItem ifTrue:[
x := x + itemSpace
]
]
]
].
].
] ifTrue:[
x0 := margin.
x1 := extent x - margin. "/ -1
items keysAndValuesDo:[:anIndex :el|
el isVisible ifFalse:[
el layout:(Rectangle left:x0 top:y right:x1 bottom:y)
] ifTrue:[
el isButton ifTrue:[
inset := DefaultButtonItemSpace
] ifFalse:[
inset := labelInset
].
y0 := y + inset.
y1 := y0 + el preferredExtent y.
el layout:(Rectangle left:(x0 + inset) top:y0 right:(x1 - inset) bottom:y1).
y := y1 + inset.
size ~~ anIndex ifTrue:[
(self hasGroupDividerAt:anIndex) ifTrue:[
y := y + groupDividerSize
"/ ] ifFalse:[
"/ y := y + itemSpace
]
]
]
]
].
self rearrangeGroups.
mustRearrange := false.
!
rearrangeItemsIfItemVisibilityChanged
"check for items which can change its visibility;
if at least one item exists, rearrange all items
"
items isNil ifTrue:[^ self].
items do:[:item |
item canChangeVisibility ifTrue:[
mustRearrange := true.
self rearrangeItems.
^ self
].
]
!
redrawX:x y:y width:w height:h
"redraw a rectangle
"
|isVertical item layout prevClip
x1 "{ Class:SmallInteger }"
x2 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
y2 "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
groupDivInset "{ Class:SmallInteger }"
|
(shown and:[w ~~ 0]) ifFalse:[^ self].
mustRearrange ifTrue:[
self isPopUpView not ifTrue:[explicitExtent := true].
self rearrangeItems.
^ self invalidate
].
self paint:(self backgroundColor).
self clearRectangleX:x y:y width:w height:h.
(size := items size) == 0 ifTrue:[
^ self
].
isVertical := self verticalLayout.
isVertical ifTrue:[
start := items findFirst:[:el| el layout bottom > y ].
start == 0 ifTrue:[ ^ self ].
y1 := y + h.
stop := items findFirst:[:el| el layout top > y1 ] startingAt:(start + 1).
] ifFalse:[
start := items findFirst:[:el| el layout right > x ].
start == 0 ifTrue:[ ^ self ].
x1 := x + w.
stop := items findFirst:[:el| el layout left > x1] startingAt:(start + 1).
].
stop == 0 ifTrue:[stop := size] ifFalse:[stop := stop - 1].
(groupSizes size ~~ 0 and:[self showGroupDivider]) ifTrue:[
groupDivInset := groupDividerSize // 2.
groupDivInset ~~ 0 ifTrue:[
(start ~~ 1 and:[self hasGroupDividerAt:(start-1)]) ifTrue:[
start := start - 1
]
].
] ifFalse:[
groupDivInset := 0
].
prevClip := clipRect.
self clippingRectangle:(Rectangle left:x top:y width:w height:h).
start to:stop do:[:i|
item := items at:i.
item redraw.
(groupDivInset ~~ 0 and:[i ~~ size and:[self hasGroupDividerAt:i]]) ifTrue:[
layout := item layout.
isVertical ifTrue:[
x1 := layout left.
x2 := layout right.
y1 := layout bottom + groupDivInset.
y2 := y1.
] ifFalse:[
y1 := layout top.
y2 := layout bottom.
x1 := layout right + groupDivInset.
x2 := x1.
].
self paint:shadowColor.
self displayLineFromX:x1 y:y1 toX:x2 y:y2.
self paint:lightColor.
isVertical ifTrue:[y1 := y1 + 1. y2 := y1 ]
ifFalse:[x1 := x1 + 1. x2 := x1 ].
self displayLineFromX:x1 y:y1 toX:x2 y:y2
]
].
self clippingRectangle:prevClip.
"Modified: / 21.5.1999 / 20:14:07 / cg"
! !
!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
!
indexOfItem:anItem
"returns the index of the item or 0
"
^ items notNil ifTrue:[items identityIndexOf:anItem] ifFalse:[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
"
|menue point sensor|
sensor := self sensor.
(sensor isNil or:[sensor hasButtonMotionEventFor:nil]) ifTrue:[
^ self
].
menue := self detectGrabMenu.
point := menue translateGrabPoint:(x@y).
menue handleButtonMotion:state x:(point x) y:(point y).
(self isPopUpView or:[sensor anyButtonPressed]) ifTrue:[
^ self
].
(selection notNil and:[selection currentSubmenu isNil]) ifTrue:[
"/ selection on grabView withou a submenu (Button ...); check whether moving out
(self containsPointX:x y:y) ifFalse:[
^ self accept:nil
]
].
!
buttonPress:button x:x y:y
"any button pressed; open or close the corresponding submenus
"
|srcPoint dstMenu dstPoint dstItem|
srcPoint := x@y.
dstMenu := self detectMenuAtGrabPoint:srcPoint.
dstMenu isNil ifTrue:[
^ self accept:nil.
].
dstPoint := dstMenu translateGrabPoint:srcPoint.
dstItem := dstMenu itemAtX:(dstPoint x) y:(dstPoint y).
dstMenu selection:dstItem.
!
buttonRelease:button x:x y:y
"button release action; accept selection and close all views
"
|topMenu dstMenu item srcPoint dstPoint|
topMenu := self topMenu.
dstMenu := topMenu activeMenu.
( dstMenu selection notNil
or:[dstMenu isPopUpView not
or:[(OperatingSystem millisecondTimeDeltaBetween:(Time millisecondClockValue)
and:(dstMenu mapTime)) > 400]]
) ifTrue:[
srcPoint := x@y.
( (dstMenu := self detectMenuAtGrabPoint:srcPoint) notNil
and:[(item := dstMenu selection) notNil]
) ifTrue:[
item currentSubmenu notNil ifTrue:[
dstMenu selection:nil.
(selection isNil and:[self isPopUpView not]) ifTrue:[
self accept:nil
].
^ self
].
dstPoint := dstMenu translateGrabPoint:srcPoint.
(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)) == dstMenu selection ifFalse:[
item := nil
].
^ topMenu acceptItem:item inMenu:dstMenu.
].
(selection notNil and:[dstMenu == self]) ifTrue:[
selection currentSubmenu notNil ifTrue:[
^ self
]
].
self accept:nil.
].
!
keyPress:key x:x y:y
"any key is pressed
"
|menu point|
(key == #Tab
or:[key == #FocusNext
or:[key == #FocusPrevious]]) ifTrue:[
self accept:nil.
^ super keyPress:key x:x y:y
].
menu := self detectGrabMenu.
key == #Escape ifTrue:[
"/ must hide the active menu
((menu := menu superMenu) notNil and:[menu ~~ self]) ifTrue:[
"/ hide active menu but keep the grab
menu selection:nil
] ifFalse:[
"/ hide active menu and ungrab
self accept:nil
].
^ self
].
[ menu shown ifTrue:[
point := menu translateGrabPoint:(x@y).
menu handleKeyPress:key x:(point x) y:(point y).
selection isNil ifTrue:[
self accept:nil.
].
^ self
].
(menu := menu superMenu) notNil
] whileTrue.
self accept:nil
!
pointerLeave:state
self detectGrabMenu handlePointerLeave:state.
self isPopUpView ifTrue:[
^ self
].
(selection notNil and:[selection currentSubmenu isNil]) ifTrue:[
"/ selection on grabView withou a submenu (Button ...); check whether moving out
self sensor anyButtonPressed ifFalse:[
^ self accept:nil
]
].
!
processShortcutKeyEventInMenuBar:event
"an event as forwarded from the keyboardProcessor -
if there is a short-key for that character, process it
and return true. Otherwise, return false.
"
|key winGroup|
key := event key.
key isCharacter ifFalse:[
( #(
#Meta_L
#CursorUp
#CursorDown
#CursorLeft
#CursorRight
#Return
#Tab
#FocusNext
#FocusPrevious
#Escape
) includesIdentical:key
) ifFalse:[
(self processShortcutKeyInMenuBar:key) ifTrue:[
(selection notNil and:[(winGroup := self windowGroup) notNil]) ifTrue:[
winGroup focusView:self
].
^ true
].
]
].
^ false
!
sizeChanged:how
"redraw #right groups
"
|index layout invRect w right|
(mustRearrange or:[self isPopUpView]) ifTrue:[
^ super sizeChanged:how
].
index := self findFirst:[:anItem| anItem startGroup == #right ].
index ~~ 0 ifTrue:[
(shown not or:[index == 1]) ifTrue:[
self mustRearrange.
] ifFalse:[
layout := (items at:(index -1)) layout.
right := 1 + layout right.
(w := width - right) > margin ifTrue:[
invRect := Rectangle left:right top:0 width:w height:height.
items from:index do:[:anItem|
anItem isVisible ifTrue:[
layout := anItem layout.
layout setLeft:right.
right := layout right.
]
].
self rearrangeGroups.
self invalidate:invRect
]
]
].
super sizeChanged:how
! !
!MenuPanel methodsFor:'event handling processing'!
handleButtonMotion:state x:x y:y
"open or close the corresponding submenus
"
|menu point sel|
self sensor anyButtonPressed ifFalse:[
"/ highlight enterItem if no selection exists
selection isNil ifTrue:[
(self containsPointX:x y:y) ifTrue:[
((sel := self itemAtX:x y:y) isNil or:[sel canSelect not]) ifTrue:[
^ self pointerEntersItem:nil
].
(DefaultSelectionFollowsMouse and:[superMenu notNil]) ifTrue:[
self selection:sel
] ifFalse:[
self pointerEntersItem:sel
].
^ self
].
].
self pointerEntersItem:nil.
(DefaultSelectionFollowsMouse and:[(menu := self superMenuAtX:x y:y) notNil]) ifTrue:[
point := self translatePoint:(x@y) to:menu.
sel := menu itemAtX:(point x) y:(point y).
(sel notNil and:[sel canSelect]) ifTrue:[
menu selection:sel
]
].
^ self
].
self pointerEntersItem:nil.
(menu := self superMenuAtX:x y:y) isNil ifTrue:[
self isPopUpView ifTrue:[
self selection:nil
].
^ self
].
menu == self ifTrue:[
(sel := self itemAtX:x y:y) notNil ifTrue:[
self selection:sel.
].
] ifFalse:[
point := self translatePoint:(x@y) to:menu.
sel := menu itemAtX:(point x) y:(point y).
(sel isNil and:[menu isPopUpView not]) ifTrue:[
sel := menu selection.
].
menu selection:sel
]
!
handleCursorKey:aKey
"handle a cursor key
"
|next submenu item
n "{ Class:SmallInteger }"
idx "{ Class:SmallInteger }"
first "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
(selection isNil and:[superMenu notNil]) ifTrue:[
^ superMenu handleCursorKey: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 currentSubmenu) 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).
size := items size.
n timesRepeat:[
next ifTrue:[
[((idx := idx + 1) <= size and:[(items at:idx) canSelect not])
] whileTrue.
idx > 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.
!
handleKeyPress:key x:x y:y
"any key is pressed
"
|item|
(key == #Return or:[key == Character space]) ifTrue:[
^ self accept.
].
key isCharacter ifFalse:[
( key == #CursorDown or:[key == #CursorUp
or:[key == #CursorLeft or:[key == #CursorRight]]]
) ifTrue:[
self handleCursorKey:key
] ifFalse:[
self processShortcutKeyInMenuBar:key
].
^ self
].
(item := self detectItemForKey:key) notNil ifTrue:[
self selection:item.
] ifFalse:[
superMenu notNil ifTrue:[
item := superMenu detectItemForKey:key.
(item notNil or:[superMenu superMenu notNil]) ifTrue:[
superMenu selection:item
]
]
].
!
handlePointerLeave:state
self pointerEntersItem:nil.
super pointerLeave:state
!
pointerEntersItem:anItemOrNil
"the pointer moves over an item or nil; restore the old item and
redraw the new item highlighted.
"
|oldItem newItem|
( anItemOrNil notNil
and:[anItemOrNil canSelect
and:[selection isNil
and:[self isPopUpView not]]]) ifTrue:[
anItemOrNil isButton ifTrue:[
( buttonEnteredBgColor ~= ButtonPassiveBackgroundColor
or:[ButtonEnteredLevel ~~ ButtonPassiveLevel]
) ifTrue:[
newItem := anItemOrNil
]
] ifFalse:[
DefaultEnteredLevel ~~ 0 ifTrue:[
newItem := anItemOrNil
]
]
].
newItem ~~ enteredItem ifTrue:[
oldItem := enteredItem.
enteredItem := newItem.
oldItem notNil ifTrue:[
self invalidateItem:oldItem repairNow:(enteredItem isNil).
].
enteredItem notNil ifTrue:[
self invalidateItem:enteredItem repairNow:true.
].
].
! !
!MenuPanel methodsFor:'grabbing'!
doGrab
relativeGrabOrigin := nil.
superMenu notNil ifTrue:[
superMenu doGrab
] ifFalse:[
hasImplicitGrap ~~ true ifTrue:[
self grabMouseAndKeyboard.
hasImplicitGrap := true
]
]
!
doUngrab:forceDo
relativeGrabOrigin := nil.
superMenu notNil ifTrue:[
forceDo ifTrue:[
superMenu doUngrab:true
].
^ self
].
hasImplicitGrap ~~ true ifTrue:[
^ self
].
forceDo ifFalse:[
(selection notNil or:[prevFocusView == self]) ifTrue:[
^ self
].
].
self ungrabMouseAndKeyboard.
self selection:nil.
hasImplicitGrap := nil.
prevFocusView := nil.
!
grabKeyboard
"grap the keyboard; keep previous grab
"
previousKeyboardGrab := device activeKeyboardGrab.
^ super grabKeyboard
!
grabMouseAndKeyboard
"get exclusive access to pointer and keyboard.
"
|sensor|
realized ifTrue:[
prevFocusView := self windowGroup focusView.
sensor := self sensor.
device activePointerGrab ~~ self ifTrue:[
sensor notNil ifTrue:[
sensor flushMotionEventsFor:nil.
].
(self grabPointer) ifFalse:[
Delay waitForSeconds:0.1.
(self grabPointer) ifFalse:[
"give up"
'MenuPanel [warning]: could not grab pointer' errorPrintCR.
self unmap
]
]
].
device activeKeyboardGrab ~~ self ifTrue:[
sensor notNil ifTrue:[
device sync.
sensor flushKeyboardFor:nil
].
self grabKeyboard.
]
]
"Modified: / 2.2.1998 / 23:43:59 / stefan"
"Modified: / 15.3.1999 / 12:01:38 / cg"
!
grabPointerWithCursor:aCursorOrNil
"grap the pointer; keep previous grab
"
previousPointerGrab := device activePointerGrab.
hasImplicitGrap := true.
^ super grabPointerWithCursor:aCursorOrNil
!
ungrabKeyboard
"ungrap the keyboard; restore previous grab
"
super ungrabKeyboard.
previousKeyboardGrab notNil ifTrue:[
device grabKeyboardInView:previousKeyboardGrab.
].
!
ungrabMouseAndKeyboard
"ungrab resources (mouse and keyboard)
"
self ungrabPointer.
self ungrabKeyboard.
!
ungrabPointer
"ungrap the pointer; restore previous grab
"
super ungrabPointer.
previousPointerGrab notNil ifTrue:[
device grabPointerInView:previousPointerGrab.
].
! !
!MenuPanel methodsFor:'help'!
helpText
"return the helpText for the currently selected item (empty if none)
"
^ self helpTextForItem:selection
!
helpTextAt:srcPoint
"return the helpText for aPoint (i.e. when mouse-pointer is moved over an item).
If there is a selection, that items helpText is used (ignoreing the given point).
"
|dstMenu dstPoint|
dstMenu := self detectMenuAtGrabPoint:srcPoint.
dstMenu isNil ifTrue:[
^ ''
].
dstPoint := dstMenu translateGrabPoint:srcPoint.
^ dstMenu helpTextForItem:(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)).
!
helpTextForItem:anItem
"returns the helpText for an item (empty if none)
"
|key val app|
anItem isNil ifTrue:[^ ''].
(val := anItem activeHelpText) isNil ifTrue:[
( (key := anItem activeHelpKey) notNil
and:[(app := self application) notNil]
) ifTrue:[
val := app helpTextForKey:key.
].
anItem activeHelpText:(val ? '').
].
^ val
! !
!MenuPanel methodsFor:'image registration'!
imageOnDevice:anImage
"returns image registered on device
"
^ self class image:anImage onDevice:device
!
lightenedImageOnDevice:anImage
"returns lightened image registered on device
"
^ self class lightenedImage:anImage onDevice:device
! !
!MenuPanel methodsFor:'initialization & release'!
addToCurrentProject
"ignored here"
^self
!
create
"create the shadow view for a none contained submenu
"
super create.
self isPopUpView ifTrue:[
(PopUpView shadowsOnDevice:device) ifTrue:[
shadowView isNil ifTrue:[
shadowView := (ShadowView onDevice:device) for:self
] ifFalse:[
self saveUnder:true.
].
]
] ifFalse:[
explicitExtent == true ifTrue:[
(self width) == (superView width) ifTrue:[
self verticalLayout:false
]
]
]
"Modified: / 28.7.1998 / 02:11:44 / cg"
!
destroy
"destroy items and shadowView; remove dependencies
"
self clearLastActiveMenu.
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].
"Modified: / 27.2.1998 / 17:41:25 / cg"
!
fetchDeviceResources
"fetch device colors, to avoid reallocation at redraw time"
|style bw lvl|
super fetchDeviceResources.
"/ thats a kludge - will be replaced by values from the styleSheet ...
"/ (i.e. read menu.buttonActiveLevel & menu.buttonPassiveLevel)
onLevel := styleSheet at:#'menu.hilightLevel' default:0.
self isPopUpView ifTrue:[
bw := styleSheet at:#'popup.borderWidth' default:1.
lvl := styleSheet at:#'popup.level' default:0.
] ifFalse:[
bw := styleSheet is3D ifFalse:[1] ifTrue:[0].
lvl := 1.
].
self borderWidth:bw.
self level:lvl.
superMenu isNil ifTrue:[
fgColor := DefaultForegroundColor onDevice:device.
activeBgColor := DefaultHilightBackgroundColor onDevice:device.
activeFgColor := DefaultHilightForegroundColor onDevice:device.
disabledFgColor := DefaultDisabledForegroundColor onDevice:device.
rightArrow := RightArrowForm onDevice:device.
selectionFrameBrightColor := SelectionFrameBrightColor onDevice:device.
selectionFrameDarkColor := SelectionFrameDarkColor onDevice:device.
buttonLightColor := ButtonLightColor onDevice:device.
buttonShadowColor := ButtonShadowColor onDevice:device.
ButtonHalfLightColor notNil ifTrue: [
buttonHalfLightColor := ButtonHalfLightColor onDevice:device].
ButtonHalfShadowColor notNil ifTrue: [
buttonHalfShadowColor := ButtonHalfShadowColor onDevice:device].
buttonEnteredBgColor := ButtonEnteredBackgroundColor 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.
selectionFrameBrightColor := superMenu selectionFrameBrightColor.
selectionFrameDarkColor := superMenu selectionFrameDarkColor.
buttonLightColor := superMenu buttonLightColor.
buttonShadowColor := superMenu buttonShadowColor.
buttonHalfLightColor := superMenu buttonHalfLightColor.
buttonHalfShadowColor := superMenu buttonHalfShadowColor.
buttonEnteredBgColor := superMenu buttonEnteredBackgroundColor.
].
"Modified: / 15.9.1998 / 12:51:29 / cg"
!
initStyle
"initialize style specific stuff"
super initStyle.
viewBackground := DefaultBackgroundColor.
onLevel := DefaultHilightLevel.
offLevel := 0. "/ DefaultLevel.
itemSpace := DefaultItemSpace.
groupDividerSize := DefaultGroupDividerSize.
fitFirstPanel := false.
font := MenuView defaultFont.
!
initialize
"set default configuration
"
super initialize.
enabled := true.
originChanged := extentChanged := false.
explicitExtent := nil.
shortKeyInset := 0.
mustRearrange := false.
"Modified: / 15.9.1998 / 12:49:51 / cg"
!
map
"grab the pointer here, when visible (but not if control has already been lost).
If the grab fails, try again and unmap myself if that fails too.
"
|anItemList|
enteredItem := nil.
self enableMotionEvents.
self becomesActiveMenu.
super map.
anItemList := InitialSelectionQuerySignal query.
self do:[:anItem| anItem fetchImages ].
self isPopUpView ifTrue:[
self doGrab
] ifFalse:[
super viewBackground:(self backgroundColor).
].
self do:[:el| el updateIndicators ].
anItemList size > 0 ifTrue:[
self redrawX:0 y:0 width:width height:height.
self openMenusFromItems:anItemList.
].
"Modified: / 19.11.1998 / 12:59:00 / cg"
"Modified: / 18.3.1999 / 18:22:18 / stefan"
!
realize
"realize menu and shadowView
"
self isPopUpView ifTrue:[
"Because of #saveUnder of ShadowView the order of realize is significant:
shadowView must be realized before self"
self hiddenOnRealize:true.
super realize.
self resize.
self makeFullyVisible.
shadowView notNil ifTrue:[
shadowView realize.
].
self raise.
self map.
] ifFalse:[
super realize.
]
!
recreate
"this is called after a snapin. If the image was saved with an active menu,
hide the menu
"
selection := nil.
super recreate.
!
reinitStyle
"handle style change while being open (win32 only - for now)"
super reinitStyle.
self fetchDeviceResources.
items notNil ifTrue:[
items do:[:anItem |
anItem reinitSubmenuStyle
]
]
"Created: / 10.9.1998 / 21:37:05 / cg"
"Modified: / 11.9.1998 / 13:20:57 / cg"
!
unmap
"unmap the view - the view stays created (but invisible), and can be remapped again later.
If we have a popup supermenu, it will get all keyboard and mouse events."
self clearLastActiveMenu.
self doUngrab:(superMenu isNil).
"/ self isPopUpView ifTrue:[
"/ self doUngrab:(superMenu isNil)
"/ ].
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 my supermenu from which i'am activated
"
(superMenu := aSuperMenu) notNil ifTrue:[
super font:(superMenu font)
].
!
topMenu
"returns the topMenu; the one having no superMenu
"
^ superMenu isNil ifTrue:[self]
ifFalse:[superMenu topMenu]
! !
!MenuPanel methodsFor:'printing'!
printString
"return a printed representation of the menu
"
|string label|
string := 'Menu:'.
self do:[:anItem|
label := anItem label ? ''.
string := string ,' ', label printString.
].
^ string
"Modified: / 27.2.1998 / 17:41:22 / cg"
! !
!MenuPanel methodsFor:'private'!
application
"optimize access to retrive the application
"
|appl akey|
superMenu notNil ifTrue:[
^ superMenu application
].
akey := #appl.
appl := self menuAdornmentAt:akey.
appl isNil ifTrue:[
(appl := super application) isNil ifTrue:[
windowGroup isNil ifTrue:[
^ nil "/ RETRY LATER
].
appl := (windowGroup mainGroup topViews first application) ? akey
].
self menuAdornmentAt:akey put:appl
].
^ appl ~~ akey ifTrue:[appl] ifFalse:[nil]
!
detectItemForKey:aKey
"returns the item assigned to a key, accessCharacter or starts with.
if no item is detected nil is returned.
"
|cIdx uKey lKey item|
items isNil ifTrue:[^ nil].
cIdx := self selectionIndex.
uKey := aKey asUppercase.
lKey := aKey asLowercase.
items keysAndValuesDo:[:anIndex :anItem| |char label|
( anIndex ~~ cIdx
and:[anItem canSelect
and:[(label := anItem textLabel) notNil
and:[label size ~~ 0]]]
) ifTrue:[
(char := anItem accessCharacter) notNil ifTrue:[
(char == uKey or:[char == lKey]) ifTrue:[
^ anItem
]
] ifFalse:[
char := label at:1.
(char == uKey or:[char == lKey]) ifTrue:[
anIndex > cIdx ifTrue:[
^ anItem
].
item isNil ifTrue:[item := anItem]
]
]
]
].
^ item
!
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 size == 0 ifTrue:[
^ self
].
item := anItemList removeFirst.
item enabled ifFalse:[
^ self
].
InitialSelectionQuerySignal answer:anItemList do:[
self selection:item
]
!
processShortcutKeyInMenuBar:aKey
"if there is a short-key for that character, process it
and return true. Otherwise, return false.
"
|rawKey loItems item maxDepth menu|
superMenu notNil ifTrue:[
"/ must start from topMenu
^ self topMenu processShortcutKeyInMenuBar:aKey
].
"/ cg: must limit the recursion (see GUIDemoToolBar - pressing CTRL in the recursive-link example)
maxDepth := 10.
rawKey := device keyboardMap keyAtValue:aKey ifAbsent:aKey.
loItems := self selectItemsForShortcutKey:rawKey maxDepth:maxDepth.
(loItems isNil and:[aKey ~~ rawKey]) ifTrue:[
loItems := self selectItemsForShortcutKey:aKey maxDepth:maxDepth.
].
loItems size == 0 ifTrue:[
^ false
].
item := loItems last.
item hasSubmenu ifFalse:[
self accept:item.
^ true
].
menu := self.
[menu selection == (loItems at:1)] whileTrue:[
loItems removeFirst.
loItems isEmpty ifTrue:[
^ false
].
menu := selection submenu.
].
menu openMenusFromItems:loItems.
^ true.
!
registerImageOnDevice:anImage
|image|
(image := anImage) notNil ifTrue:[
image device ~~ device ifTrue:[
image := image copy.
].
image := image on:device.
image := image clearMaskedPixels.
].
^ image
!
selectItemsForShortcutKey:aKey maxDepth:maxDepth
"get sequence of items up to the item providing the key (inclusive). The
last entry into the collection is the item providing the key, the first
entry is the item in the topMenu
"
|seq menu|
maxDepth <= 0 ifTrue:[^ nil].
self do:[:anItem|
anItem isEnabled ifTrue:[
anItem shortcutKey == aKey ifTrue:[
seq := OrderedCollection new.
] ifFalse:[
(menu := anItem currentSubmenu) notNil ifTrue:[
seq := menu selectItemsForShortcutKey:aKey maxDepth:maxDepth-1
]
].
seq notNil ifTrue:[
seq addFirst:anItem.
^ seq
]
]
].
^ nil
"Created: / 19.1.1999 / 16:00:16 / cg"
! !
!MenuPanel methodsFor:'private activation'!
activeMenu
"returns the current active menu or self (the top menu)
"
^ lastActiveMenu ? self
"Created: / 27.2.1998 / 17:41:15 / cg"
!
activeMenu:aMenu
"set the current active menu
"
lastActiveMenu := aMenu
"Created: / 27.2.1998 / 17:41:16 / cg"
!
becomesActiveMenu
"submenu becomes the active menu
"
mapTime := Time millisecondClockValue.
self topMenu activeMenu:self.
"Created: / 27.2.1998 / 17:41:23 / cg"
!
clearLastActiveMenu
"reset the current active menu
"
|top|
top := self topMenu.
prevFocusView notNil ifTrue:[
self windowGroup focusView:prevFocusView.
prevFocusView := nil.
].
top activeMenu == self ifTrue:[
top activeMenu:nil
]
"Created: / 27.2.1998 / 17:41:17 / cg"
!
mapTime
"returns the time when the menu becomes active
"
^ mapTime
"Modified: / 27.2.1998 / 17:41:18 / cg"
! !
!MenuPanel methodsFor:'private searching'!
detectGrabMenu
"returns the menu which is responsible for the grap; the last opened menu
"
|subMenu|
selection notNil ifTrue:[
(subMenu := selection currentSubmenu) notNil ifTrue:[
^ subMenu detectGrabMenu
]
].
^ self
!
detectMenuAtGrabPoint:aGrabPoint
"returns the menu which contains the grab-point
"
|dstMenu dstPoint firstMenu|
dstPoint := self translateGrabPoint:aGrabPoint.
((dstPoint x between:0 and:width) and:[dstPoint y between:0 and:height]) ifTrue:[
firstMenu := self.
].
(selection isNil or:[(dstMenu := selection currentSubmenu) isNil]) ifTrue:[
^ firstMenu
].
dstMenu := dstMenu detectMenuAtGrabPoint:aGrabPoint.
^ dstMenu ? firstMenu
!
itemAtX:x y:y
"returns the item at a point x@y or nil if none detected
"
items notNil ifTrue:[
^ items detect:[:el| el containsPointX:x y:y] ifNone:nil
].
^ nil
!
superMenuAtX:x y:y
"returns the superMenu which contains the point x@y or nil if none detected
"
|grabPoint superMenu|
(self containsPointX:x y:y) ifTrue:[
^ self
].
grabPoint := (x@y) - (self translateGrabPoint:0@0).
superMenu := self.
[ (superMenu := superMenu superMenu) notNil ] whileTrue:[
(superMenu containsPoint:(superMenu translateGrabPoint:grabPoint)) ifTrue:[
^ superMenu
]
].
^ nil
!
translateGrabPoint:aGrabPoint
"translate the grab point into self
"
|myPoint|
superMenu isNil ifTrue:[
"I am the grapView"
^ aGrabPoint
].
relativeGrabOrigin isNil ifTrue:[
relativeGrabOrigin := device translatePoint:0@0 from:(self topMenu id) to:(self id).
].
^ relativeGrabOrigin + aGrabPoint
!
translatePoint:aPoint to:aMenu
"translate a point into another menu its point
"
|grapPoint|
aMenu == self ifTrue:[
^ aPoint
].
grapPoint := aPoint - (self translateGrabPoint:0@0).
^ aMenu translateGrabPoint:grapPoint
! !
!MenuPanel methodsFor:'queries'!
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
"
^ (x between:0 and:width) and:[y between:0 and:height]
!
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;
NOT SUPPORTED
"
^ false
!
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
!
selection
"returns current selected item or nil
"
^ selection
!
selection:anItemOrNil
"change selection to an item
"
|item newSel hlp|
(newSel := anItemOrNil) isNumber ifTrue:[
newSel := self itemAt:anItemOrNil
].
(newSel notNil and:[newSel canSelect]) ifFalse:[
newSel := nil
].
selection == newSel ifTrue:[^ self].
(item := selection) notNil ifTrue:[
selection := nil.
item selected:false.
].
newSel notNil ifTrue:[
newSel == enteredItem ifTrue:[
enteredItem := nil
] ifFalse:[
self pointerEntersItem:nil
].
selection := newSel.
ActiveHelp isActive ifTrue:[
hlp := ActiveHelp currentHelpListener.
hlp initiateHelpFor:self atX:nil y:nil now:true.
].
realized ifTrue:[self rearrangeItems].
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
!
verticalInset
^ VerticalInset
! !
!MenuPanel::Item class methodsFor:'defaults'!
separatorSize
"returns size of a separator
"
^ 10
!
updateStyleCache
"setup defaults
self updateStyleCache
"
HorizontalInset := 2.
VerticalInset := 2.
HorizontalButtonInset := 3.
VerticalButtonInset := 3.
LabelRightOffset := 15.
! !
!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 or choice
"
|arg|
indication notNil ifTrue:[
arg := self indicationValue not.
self indicationValue:arg.
] ifFalse:[
choice notNil ifTrue:[
choice value:choiceValue.
^ true
]
].
^ arg
! !
!MenuPanel::Item methodsFor:'accessing'!
accessCharacter
"returns my accessCharacter or nil
"
^ accessCharacter
!
accessCharacterPosition
"get the access character position or nil
"
^ accessCharacterPosition
!
accessCharacterPosition:anIndex
"set the access character position or nil
"
accessCharacterPosition := anIndex.
!
argument
"gets the argument
"
^ argument
!
argument:anArgument
"sets the argument
"
argument := anArgument.
!
currentSubmenu
"returns the current submenu or nil
"
^ subMenu
!
label
"returns the label
"
^ label
!
label:aLabel
"set a new label; if the label changed, a redraw is performed;
handle characters $& (ST-80 compatibility)
"
|size char lbl
h "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
|
accessCharacter := rawLabelExtent := disabledRawLabel := nil.
label := aLabel value.
rawLabel := label value ? ''.
rawLabel isString ifTrue:[
"CHECK FOR SEPARATOR"
(isButton not and:[indication isNil and:[choice isNil]]) ifTrue:[
size := rawLabel size.
size == 0 ifTrue:[
rawLabel := nil. "blank separator"
^ self
].
size == 1 ifTrue:[
char := rawLabel first.
(char == $- or:[char == $=]) ifTrue:[
label := rawLabel. "line separator"
rawLabel := nil.
^ self
]
]
]
] ifFalse:[
rawLabel isCollection ifTrue:[
rawLabel := rawLabel asArray.
]
].
rawLabel isArray ifTrue:[
w := h := 0.
rawLabel keysAndValuesDo:[:i :el|
el notNil ifTrue:[
lbl := self updateAccessCharacterFor:el.
rawLabel at:i put:lbl.
w := w max:(lbl widthOn:menuPanel).
h := h + 1 + (lbl heightOn:menuPanel).
] ifFalse:[
h := h + 3
]
]
] ifFalse:[
rawLabel := self updateAccessCharacterFor:rawLabel.
w := rawLabel widthOn:menuPanel.
h := rawLabel heightOn:menuPanel.
].
rawLabelExtent := w@h.
menuPanel shown ifTrue:[ self fetchImages ].
menuPanel mustRearrange
!
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).
"
^ 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).
"
shortcutKey ~~ aKey ifTrue:[
shortcutKey := aKey.
self invalidate.
].
!
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 := aSymbol.
!
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 new.
menuPanel notNil ifTrue:[
subMenu receiver:menuPanel receiver.
].
subMenu superMenu:menuPanel.
subMenu menu:aSubMenu.
] ifFalse:[
subMenu isView ifTrue:[
subMenu superMenu:menuPanel.
]
]
].
"Modified: / 10.8.1998 / 13:26:28 / cg"
!
textLabel
"returns my textLabel or nil if none text
"
|txt|
rawLabel notNil ifTrue:[
rawLabel isArray ifFalse:[
^ rawLabel perform:#string ifNotUnderstood:nil
].
rawLabel do:[:el|
(txt := el perform:#string ifNotUnderstood:nil) notNil ifTrue:[
^ txt
]
].
].
^ 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
"
value := aValue.
argument := anArgument.
! !
!MenuPanel::Item methodsFor:'accessing-behavior'!
choice
"implements a radio group; the field
"
^ choice
!
choice:something
"set choice indication
"
choice == something ifTrue:[^ self].
choice isValueModel ifTrue:[
choice removeDependent:self
].
(choice := something) notNil ifTrue:[
choice isSymbol ifTrue:[
(choice := self aspectAt:choice) isNil ifTrue:[
choice := something
]
].
choice isValueModel ifTrue:[
choice addDependent:self
]
].
!
choiceValue
"implements a radio group; the value writen to the choice if selected
"
^ choiceValue
!
choiceValue:something
"implements a radio group; the value writen to the choice if selected
"
choiceValue ~= something ifTrue:[
choiceValue := something.
choice notNil ifTrue:[
self invalidate
]
].
!
enabled
"returns the enabled state
"
|state|
menuPanel enabled ifTrue:[
enableChannel isSymbol ifTrue:[
state := self aspectAt:enableChannel.
state isValueModel ifTrue:[
enableChannel := state.
enableChannel addDependent:self.
state := enableChannel value.
] ifFalse:[
state := state 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.
enableChannel isValueModel ifTrue:[
enableChannel removeDependent:self
]
].
enableChannel := something.
enableChannel isNil ifTrue:[
menuPanel shown ifFalse:[^ self].
newState := true
] ifFalse:[
enableChannel isValueModel ifTrue:[
enableChannel addDependent:self
] ifFalse:[
enableChannel isSymbol ifTrue:[^ self]
].
menuPanel shown ifFalse:[^ self].
newState := enableChannel value.
].
newState ~~ oldState ifTrue:[
self invalidate
].
!
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.
!
indication
"get on/off indication
"
^ indication
!
indication:something
"set on/off indication
"
indication == something ifTrue:[^ self].
indication isValueModel ifTrue:[
indication removeDependent:self
].
(indication := something) notNil ifTrue:[
indication isValueModel ifTrue:[
indication addDependent:self
] ifFalse:[
"/ to force an update of the value
self indicationValue
]
].
!
isButton
"returns whether item looks like a Button
"
^ isButton
!
isButton:anBoolean
"sets whether item looks like a Button
"
isButton := anBoolean.
layout notNil ifTrue:[
self redrawAsButton
]
!
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.
!
submenuChannel
"get the submenu channel
"
^ submenuChannel
!
submenuChannel:aSelectorOrNil
"returns the submenu channel
"
submenuChannel := aSelectorOrNil.
! !
!MenuPanel::Item methodsFor:'accessing-dimension'!
layout
"returns my layout ( Rectangle )
"
^ layout
!
layout:aLayout
"set a new layout ( Rectangle )
"
layout := aLayout.
self invalidate.
!
preferredExtent
"compute my preferred extent excluding the shortCutKey and the menu identifier
"
|isVertical
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
s "{ Class:SmallInteger }"
|
self isVisible ifFalse:[^ 0@0 ].
isButton ifTrue:[
s := menuPanel maxAbsoluteButtonLevel.
x := s + HorizontalButtonInset.
y := s + VerticalButtonInset.
] ifFalse:[
x := HorizontalInset.
y := VerticalInset.
].
x := x * 2.
y := y * 2.
isVertical := menuPanel verticalLayout.
rawLabel isNil ifTrue:[
"SEPARATOR"
s := self class separatorSize.
"width of doubleSeparator is 5 !!!!"
isVertical ifFalse:[
x := x max:s.
y := y + 5.
] ifTrue:[
y := y max:s.
x := x + 5.
].
] ifFalse:[
x := x + rawLabelExtent x.
y := y + rawLabelExtent y.
isButton ifFalse:[
menuPanel showSeparatingLines ifTrue:[
"width of separator is 2 plus right offset 1 := 3"
isVertical ifFalse:[x := x + 3] ifTrue:[y := y + 3].
].
(indication notNil or:[choice notNil]) ifTrue:[
x := x + 2 + menuPanel iconIndicationOff width.
].
]
].
^ x@y
! !
!MenuPanel::Item methodsFor:'accessing-help'!
activeHelpKey
"get the active helpKey; the key to retrieve the helpText from the application
"
^ activeHelpKey
!
activeHelpKey:aHelpKey
"set the active helpKey; the key to retrieve the helpText from the application
"
activeHelpKey ~~ aHelpKey ifTrue:[
activeHelpKey := aHelpKey.
activeHelpText := nil.
].
!
activeHelpText
"get the active helpText or nil if not yet resolved
"
^ activeHelpText
!
activeHelpText:aText
"set the active helpText
"
activeHelpText := aText.
! !
!MenuPanel::Item methodsFor:'activation / deactivation'!
hideSubmenu
"hide submenu
"
|id|
subMenu notNil ifTrue:[
subMenu realized ifFalse:[
(id := subMenu id) notNil ifTrue:[
menuPanel device unmapWindow:id
]
] ifTrue:[
subMenu hide
].
subMenu windowGroup:nil.
menuPanel windowGroup removeView:subMenu.
"/ release menu if derived from channel
submenuChannel notNil ifTrue:[
subMenu := nil
]
].
!
openSubmenu
"opens the submenu; make sure, that the submenu and the menPanel
is fully visible by shifting it into the visible screen area if
nescessary.
"
|p o device isVertical topMenu windGrp prefExtent
devBot "{ Class:SmallInteger }"
devRight "{ Class:SmallInteger }"
width "{ Class:SmallInteger }"
height "{ Class:SmallInteger }"
top "{ Class:SmallInteger }"
left "{ Class:SmallInteger }"
newLeft "{ Class:SmallInteger }"
|
(subMenu notNil and:[subMenu shown not and:[self isSelected and:[menuPanel shown]]]) ifFalse:[
^ self
].
topMenu := menuPanel topMenu.
windGrp := topMenu windowGroup.
subMenu superMenu:menuPanel.
subMenu becomesActiveMenu.
subMenu cursor:Cursor hand.
windGrp notNil ifTrue:[
subMenu windowGroup:windGrp.
windGrp addTopView:subMenu.
].
" Q&D kludge - if any visibility attributes are blocks;
TODO: only invoke mustRearrange if any are blocks
(since I react correctly on valueHolder changes)
"
subMenu rearrangeItemsIfItemVisibilityChanged.
subMenu fixSize.
"compute origin of subMenu
"
isVertical := menuPanel verticalLayout.
device := menuPanel device.
prefExtent := subMenu preferredExtent.
height := prefExtent y.
width := prefExtent x.
devBot := device usableHeight.
devRight := device usableWidth.
p := isVertical ifTrue:[layout topRight - 2] ifFalse:[layout bottomLeft].
menuPanel isPopUpView ifTrue:[
o := menuPanel origin + p
] ifFalse:[
o := device translatePoint:p from:(menuPanel id) to:(device rootWindowId).
].
left := o x.
top := o y.
left + width > devRight ifTrue:[
left := isVertical ifTrue:[left - layout width - width]
ifFalse:[devRight - width]
].
top + height > devBot ifTrue:[
top := isVertical ifTrue:[devBot - height]
ifFalse:[top - layout height - height]
].
top := top max:0.
left := left max:0.
subMenu origin:(left@top).
subMenu realized ifFalse:[
subMenu realize.
] ifTrue:[
topMenu device mapWindow:(subMenu id).
].
! !
!MenuPanel::Item methodsFor:'building'!
aspectAt:aKey
"retursns value assigned to key or nil
"
|appl value|
appl := menuPanel receiver.
(appl isValueModel) ifTrue:[
^ appl value:aKey
].
(appl notNil or:[(appl := menuPanel application) notNil]) ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == aKey ifFalse:[
ex reject
].
] do:[
(appl isKindOf:ApplicationModel)
ifTrue:[value := appl aspectFor:aKey]
ifFalse:[value := appl perform:aKey]
]
].
^ value
"Modified: / 29.7.1998 / 11:59:50 / cg"
! !
!MenuPanel::Item methodsFor:'change & update'!
update:something with:aParameter from:changedObject
|form rect|
(menuPanel isNil or:[layout isNil]) ifTrue:[^ self]. "/ not yet realized or computed
self isSeparator ifFalse:[
"/ NOT A SEPARATOR
menuPanel shown ifTrue:[
changedObject == enableChannel ifTrue:[
^ self invalidate
].
(changedObject == indication or:[changedObject == choice]) ifTrue:[
isButton ifTrue:[
self invalidate
] ifFalse:[
"/ invalidate the interactor only
"/ take any interactor; interactors has the same extent
form := menuPanel iconIndicationOff.
rect := Rectangle left:(layout left + HorizontalInset)
top:(layout top)
width:(form width)
height:(layout height).
menuPanel invalidate:rect repairNow:false
].
^ self
].
].
].
changedObject == isVisible ifTrue:[
menuPanel mustRearrange.
menuPanel rearrangeItems.
^ self.
].
super update:something with:aParameter from:changedObject
!
updateIndicators
"update indicators
"
(indication notNil and:[indication isSymbol]) ifTrue:[
" indication is a selector otherwise a change notification
is raised from the model !!!!
"
self update:nil with:nil from:indication
]
! !
!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:accessCharacterPosition.
item startGroup:startGroup.
item argument:argument.
item nameKey:nameKey.
item shortcutKeyCharacter:shortcutKey.
item value:(value value).
item indication:(indication value).
item choice:(choice value).
item choiceValue:choiceValue.
item isVisible:(self isVisible).
item hideMenuOnActivated:(self hideMenuOnActivated).
item showBusyCursorWhilePerforming:(self showBusyCursorWhilePerforming).
item isButton:isButton.
submenuChannel isSymbol ifTrue:[
item submenuChannel:submenuChannel
] ifFalse:[
subMenu notNil ifTrue:[
item submenu:(subMenu asMenu)
]
].
^ item
"Modified: / 14.8.1998 / 15:47:21 / cg"
!
menuItem:aMenuItem
"setup attributes from a MenuItem
"
|lbl|
menuPanel disabledRedrawDo:[
label := rawLabel := nil.
accessCharacterPosition := aMenuItem accessCharacterPosition.
argument := aMenuItem argument.
choiceValue := aMenuItem choiceValue.
showBusyCursorWhilePerforming := aMenuItem showBusyCursorWhilePerforming.
hideMenuOnActivated := aMenuItem hideMenuOnActivated.
isButton := aMenuItem isButton ? false.
nameKey := aMenuItem nameKey.
startGroup := aMenuItem startGroup.
shortcutKey := aMenuItem shortcutKeyCharacter.
value := aMenuItem value.
activeHelpKey := aMenuItem activeHelpKey.
activeHelpText := nil.
self enabled:(aMenuItem enabled).
self indication:(aMenuItem indication).
self choice:(aMenuItem choice).
self isVisible:(aMenuItem isVisible).
(lbl := aMenuItem labelImage value) isNil ifTrue:[
lbl := aMenuItem rawLabel. "/ avoid translating &'s twice
].
self label:lbl.
submenuChannel := aMenuItem submenuChannel.
self submenu:(aMenuItem submenu).
]
"Modified: / 22.8.1998 / 15:34:16 / cg"
! !
!MenuPanel::Item methodsFor:'drawing'!
drawButton
"draw as button
"
|drawObject fg level isSelected bg ownBgCol
x "{ Class:SmallInteger }"
|
drawObject := rawLabel.
"COMPUTE COLORS"
(isSelected := self isSelected) ifTrue:[
bg := self activeBackgroundColor.
fg := self activeForegroundColor.
] ifFalse:[
self isEntered ifTrue:[
bg := self buttonEnteredBackgroundColor
] ifFalse:[
bg := self backgroundColor
].
self enabled ifTrue:[
fg := menuPanel foregroundColor
] ifFalse:[
fg := menuPanel disabledForegroundColor.
drawObject := self disabledRawLabel
]
].
(ownBgCol := self backgroundColorFromLabel) notNil ifTrue:[
bg := ownBgCol
].
"DRAW BACKGROUND"
bg ~= menuPanel backgroundColor ifTrue:[
menuPanel paint:bg.
menuPanel fillRectangle:layout.
].
x := layout left + menuPanel buttonPassiveLevel + HorizontalButtonInset.
isSelected ifFalse:[
"check whether button should be drawn selected; indicator or radio button"
indication notNil ifTrue:[
"button is indicator and set"
isSelected := self indicationValue
] ifFalse:[
isSelected := (choice notNil and:[choice value = choiceValue]).
]
].
isSelected ifTrue:[
level := menuPanel buttonActiveLevel.
x := x + level abs.
] ifFalse:[
level := self isEntered ifTrue:[menuPanel buttonEnteredLevel]
ifFalse:[menuPanel buttonPassiveLevel].
].
self drawRawLabel:drawObject atX:x paint:fg.
level ~~ 0 ifTrue:[
menuPanel drawButtonEdgesFor:self level:level
].
!
drawLabel
"draw a labeled entry; no button, no separator.
"
|scKey cLb cLa drawObject fg arrow
isSelected form
h "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
t "{ Class:SmallInteger }"
|
drawObject := rawLabel.
(isSelected := self isSelected) ifTrue:[
fg := self activeForegroundColor
] ifFalse:[
self enabled ifTrue:[
fg := menuPanel foregroundColor
] ifFalse:[
fg := menuPanel disabledForegroundColor.
drawObject := self disabledRawLabel
]
].
h := layout height.
x := layout left + HorizontalInset.
t := layout top.
((form := self indicatorForm) notNil or:[(form := self choiceForm) notNil]) ifTrue:[
y := t + ((h - form height) // 2).
form displayOn:menuPanel x:x y:y.
x := x + 2 + form width.
].
self drawRawLabel:drawObject atX:x paint:fg.
"/ DRAW SHORTCUT KEY
( shortcutKey notNil
and:[(x := menuPanel shortKeyInset) ~~ 0
and:[(scKey:= self shortcutKeyAsString) notNil]]
) ifTrue:[
x := layout left + x.
y := t + ((h - (scKey heightOn:menuPanel)) // 2).
y := y + menuPanel font ascent.
scKey displayOn:menuPanel x:x y:y.
].
"/ DRAW SUBMENU INDICATION
(menuPanel isVerticalLayout and:[self hasSubmenu]) ifTrue:[
arrow := menuPanel rightArrow.
x := layout right - arrow width - HorizontalInset.
y := t + (h - arrow height // 2).
(menuPanel styleSheet is3D not
or:[(drawObject := menuPanel rightArrowShadow) isNil]) ifTrue:[
^ menuPanel displayForm:arrow x:x y:y
].
cLa := menuPanel shadowColor.
cLb := menuPanel lightColor.
isSelected ifFalse:[
fg := cLa.
cLa := cLb.
cLb := fg
].
menuPanel paint:cLa.
menuPanel displayForm:arrow x:x y:y.
menuPanel paint:cLb.
menuPanel displayForm:drawObject x:x y:y.
]
"Modified: / 6.9.1998 / 21:48:53 / cg"
!
drawRawLabel:aLabel atX:x paint:fg
"draw a labeled entry; no button, no separator.
"
|y "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
|
menuPanel paint:fg.
y := layout top + (layout height - rawLabelExtent y // 2).
aLabel isArray ifFalse:[
aLabel isImageOrForm ifFalse:[
y := y + menuPanel font ascent
].
^ aLabel displayOn:menuPanel x:x y:y.
].
aLabel do:[:el|
el notNil ifTrue:[
el isImageOrForm ifFalse:[
y0 := y + menuPanel font ascent
] ifTrue:[
y0 := y
].
x0 := x + (rawLabelExtent x - (el widthOn:menuPanel) // 2).
el displayOn:menuPanel x:x0 y:y0.
y := y + 1 + (el heightOn:menuPanel)
] ifFalse:[
y := y + 3 "/ see #label:
]
].
!
drawSeparatingLines
"draw separating lines
"
|index item lfSep rtSep items
l "{ Class:SmallInteger }"
t "{ Class:SmallInteger }"
r "{ Class:SmallInteger }"
b "{ Class:SmallInteger }"
|
items := menuPanel items.
index := items identityIndexOf:self.
item := items at:(index - 1) ifAbsent:nil.
lfSep := item notNil and:[item isButton not].
item := items at:(index + 1) ifAbsent:nil.
rtSep := item notNil and:[item isButton not].
(lfSep isNil and:[rtSep]) isNil ifTrue:[
^ self
].
menuPanel paint:(menuPanel lightColor).
l := layout left.
t := layout top.
r := layout right.
b := layout bottom.
menuPanel verticalLayout ifTrue:[
lfSep ifTrue:[menuPanel displayLineFromX:l y:t-1 toX:r y:t-1].
rtSep ifTrue:[menuPanel displayLineFromX:l y:b-1 toX:r y:b-1].
menuPanel paint:(menuPanel shadowColor).
lfSep ifTrue:[menuPanel displayLineFromX:l y:t-2 toX:r y:t-2].
rtSep ifTrue:[menuPanel displayLineFromX:l y:b-2 toX:r y:b-2].
] ifFalse:[
lfSep ifTrue:[menuPanel displayLineFromX:l-1 y:t toX:l-1 y:b].
rtSep ifTrue:[menuPanel displayLineFromX:r-1 y:t toX:r-1 y:b].
menuPanel paint:(menuPanel shadowColor).
lfSep ifTrue:[menuPanel displayLineFromX:l-2 y:t toX:l-2 y:b].
rtSep ifTrue:[menuPanel displayLineFromX:r-2 y:t toX:r-2 y:b].
]
!
drawSeparator
"draw as separator
"
|type lightColor isDouble
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
|
type := self separatorType.
(type isNil or:[type == #blankLine]) ifTrue:[
^ self
].
isDouble := type == #doubleLine.
lightColor := menuPanel lightColor.
menuPanel paint:(menuPanel shadowColor).
menuPanel verticalLayout ifTrue:[
x0 := layout left + HorizontalInset.
x1 := layout right - HorizontalInset.
y0 := layout top - 1 + (layout height // 2).
isDouble ifTrue:[y0 := y0 - 2].
menuPanel displayLineFromX:x0 y:y0 toX:x1 y:y0.
isDouble ifTrue:[menuPanel displayLineFromX:x0 y:y0+4 toX:x1 y:y0+4].
menuPanel paint:lightColor.
menuPanel displayLineFromX:x0 y:y0+1 toX:x1 y:y0+1.
isDouble ifTrue:[menuPanel displayLineFromX:x0 y:y0+5 toX:x1 y:y0+5].
] ifFalse:[
y1 := layout bottom.
x0 := layout left - 1 + (layout width // 2).
y0 := layout top.
isDouble ifTrue:[x0 := x0 - 2].
menuPanel displayLineFromX:x0 y:y0 toX:x0 y:y1.
isDouble ifTrue:[menuPanel displayLineFromX:x0+4 y:y0 toX:x0+4 y:y1].
menuPanel paint:lightColor.
menuPanel displayLineFromX:x0+1 y:y0 toX:x0+1 y:y1.
isDouble ifTrue:[menuPanel displayLineFromX:x0+5 y:y0 toX:x0+5 y:y1].
]
!
invalidate
(rawLabel notNil and:[menuPanel notNil]) ifTrue:[
menuPanel invalidateItem:self repairNow:false
]
!
redraw
"redraw item
"
|isSelected ownBgCol paint bgColor
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
|
self isVisible ifFalse:[^ self].
rawLabel isNil ifTrue:[^ self drawSeparator].
isButton ifTrue:[^ self drawButton].
"/ DRAW A LABELED ENTRY; no button, no separator
isSelected := self isSelected.
bgColor := menuPanel backgroundColor.
paint := isSelected ifTrue:[self activeBackgroundColor] ifFalse:[bgColor].
(ownBgCol := self backgroundColorFromLabel) notNil ifTrue:[
paint := ownBgCol
].
paint ~= bgColor ifTrue:[
menuPanel paint:paint.
menuPanel fillRectangle:layout.
].
menuPanel showSeparatingLines ifTrue:[
self drawSeparatingLines
].
self drawLabel.
(ownBgCol notNil and:[isSelected]) ifTrue:[
ownBgCol brightness > 0.5 ifTrue:[menuPanel paint: menuPanel selectionFrameDarkColor]
ifFalse:[menuPanel paint: menuPanel selectionFrameBrightColor].
x := layout left.
y := layout top.
w := layout width.
h := layout height.
menuPanel displayRectangleX:(x + 1) y:(y + 1) width:(w - 2) height:(h - 2).
menuPanel displayRectangleX:(x + 2) y:(y + 2) width:(w - 4) height:(h - 4).
].
menuPanel drawLabelEdgeFor:self selected:isSelected.
! !
!MenuPanel::Item methodsFor:'initialization'!
destroy
"destroy submenus, remove dependencies
"
self submenu:nil.
enableChannel isValueModel ifTrue:[enableChannel removeDependent:self].
isVisible isValueModel ifTrue:[isVisible removeDependent:self].
indication isValueModel ifTrue:[indication removeDependent:self].
choice isValueModel ifTrue:[choice removeDependent:self].
menuPanel := nil.
!
in:aPanel
"create item in a menuPanel
"
menuPanel := aPanel.
isButton := false.
! !
!MenuPanel::Item methodsFor:'label basics'!
disabledRawLabel
"returns the label used if the item is disabled
"
|block form image|
disabledRawLabel notNil ifTrue:[^ disabledRawLabel].
disabledRawLabel := rawLabel ? ''.
disabledRawLabel isString ifTrue:[
^ disabledRawLabel
].
block := [:el| |rslt|
(rslt := el) notNil ifTrue:[
el isImageOrForm ifTrue:[
el colorMap notNil ifTrue:[
rslt := menuPanel lightenedImageOnDevice:el
]
] ifFalse:[
el class == LabelAndIcon ifTrue:[
((form := el icon) notNil and:[form colorMap notNil]) ifTrue:[
form := menuPanel lightenedImageOnDevice:form
].
((image := el image) notNil and:[image colorMap notNil]) ifTrue:[
image := menuPanel lightenedImageOnDevice:image
].
rslt := LabelAndIcon form:form image:image string:(el string).
]
]
].
rslt
].
rawLabel isArray ifTrue:[
disabledRawLabel := Array new:(rawLabel size).
rawLabel keysAndValuesDo:[:anIndex :aLabel|
disabledRawLabel at:anIndex put:(block value:aLabel)
]
] ifFalse:[
disabledRawLabel := block value:rawLabel
].
^ disabledRawLabel
!
fetchImages
"fetch images
"
|icon block|
rawLabel notNil ifTrue:[
block := [:el| |rslt|
(rslt := el) notNil ifTrue:[
el isImageOrForm ifTrue:[
rslt := menuPanel imageOnDevice:el
] ifFalse:[
el class == LabelAndIcon ifTrue:[
(icon := el image) notNil ifTrue:[
el image:(menuPanel imageOnDevice:icon)
].
(icon := el icon) notNil ifTrue:[
el icon:(menuPanel imageOnDevice:icon)
]
]
]
].
rslt
].
rawLabel isArray ifTrue:[
rawLabel keysAndValuesDo:[:anIndex :aLabel|
rawLabel at:anIndex put:(block value:aLabel)
]
] ifFalse:[
rawLabel := block value:rawLabel
]
].
!
updateAccessCharacterFor:aLabel
|s i rest label pos|
(accessCharacter notNil or:[aLabel isNil]) ifTrue:[
^ aLabel
].
aLabel isString ifFalse:[
aLabel class == LabelAndIcon ifTrue:[
aLabel string:(self updateAccessCharacterFor:(aLabel string))
].
^ aLabel
].
s := aLabel size.
i := 1.
label := aLabel.
pos := accessCharacterPosition.
[((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:[pos := i].
s := s - 1.
].
(pos isNil or:[(accessCharacter := label at:pos ifAbsent:nil) isNil]) ifTrue:[
^ aLabel
].
label isText ifFalse:[
label := Text string:label
].
label emphasisAt:pos add:#underline.
^ label
! !
!MenuPanel::Item methodsFor:'printing & storing'!
displayString
^ self class name, '[', label printString, ']'
! !
!MenuPanel::Item methodsFor:'private'!
activeBackgroundColor
"returns the active background color derived from menuPanel
"
isButton ifTrue: [^menuPanel buttonActiveBackgroundColor].
^menuPanel activeBackgroundColor
!
activeForegroundColor
"returns the active foreground color derived from menuPanel
"
^menuPanel activeForegroundColor
!
backgroundColor
"returns the background color derived from menuPanel
"
isButton ifTrue: [^menuPanel buttonPassiveBackgroundColor].
^menuPanel backgroundColor
!
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
!
buttonEnteredBackgroundColor
"returns the background color to use when thhe mouse has entered
derived from menuPanel
"
isButton ifTrue: [^ menuPanel buttonEnteredBackgroundColor].
^ menuPanel backgroundColor
"Created: / 20.8.1998 / 13:56:10 / cg"
!
choiceForm
"returns choice form or nil
"
choice isNil ifTrue:[^ nil].
^ choice value = choiceValue ifTrue:[menuPanel iconRadioGroupOn]
ifFalse:[menuPanel iconRadioGroupOff]
!
findSubMenuIn:aRecv
"ask the receiver for a submenu aspect, sending it
#aspectFor: first; then trying the selector itself.
Ignore the error if that message is not understood
(but not other message-not-understoods)"
|subm sel|
subm := nil.
aRecv notNil ifTrue:[
submenuChannel last ~~ $: ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|
|selector|
((selector := ex parameter selector) == submenuChannel
or:[selector == #aspectFor:]) ifFalse:[
ex reject
].
] do:[
subm := aRecv aspectFor:submenuChannel
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == submenuChannel ifFalse:[
ex reject
].
] do:[
subm := aRecv perform:submenuChannel
]
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == submenuChannel ifFalse:[
ex reject
].
] do:[
subm := aRecv class perform:submenuChannel.
"/ menu provided by class; thus it will not be changed
subm notNil ifTrue:[
submenuChannel := nil.
]
]
]
] ifFalse:[
argument notNil ifTrue:[
sel := submenuChannel asSymbol.
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == sel ifFalse:[
ex reject
].
] do:[
subm := aRecv perform:sel with:argument
].
subm isNil ifTrue:[
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == sel ifFalse:[
ex reject
].
] do:[
subm := aRecv class perform:sel with:argument.
"/ menu provided by class; thus it will not be changed
subm notNil ifTrue:[
submenuChannel := nil.
]
]
]
]
]
].
^ subm
"Modified: / 4.8.1998 / 17:40:09 / cg"
!
indicationValue
"returns indication value or nil in case of no indication
"
|numArgs sel recv|
indication isNil ifTrue:[^ nil]. "no indication specified"
indication isSymbol ifFalse:[
^ indication value == true "block or model"
].
(numArgs := indication numArgs) == 2 ifTrue:[
recv := menuPanel receiver.
(recv isValueModel) ifFalse:[
(recv notNil or:[(recv := menuPanel application) notNil]) ifTrue:[
sel := indication copyFrom:1 to:(indication indexOf:$:).
sel := sel asSymbol.
Object messageNotUnderstoodSignal handle:[:ex|
ex parameter selector == sel ifFalse:[
ex reject
].
] do:[
sel := recv perform:sel with:argument
]
].
].
^ sel value == true
].
numArgs ~~ 0 ifTrue:[
sel := (indication copyWithoutLast:1) asSymbol
] ifFalse:[
sel := indication
].
sel := self aspectAt:sel.
sel isValueModel ifTrue:[
indication := sel.
indication addDependent:self.
].
^ sel value == true
!
indicationValue:aValue
"set the indication value
"
|numArgs recv|
indication isNil ifTrue:[^ self]. "no indication specified"
indication isSymbol ifFalse:[
indication perform:#value: with:aValue ifNotUnderstood:nil. "block or model"
^ self
].
(numArgs := indication numArgs) == 0 ifTrue:[ "no arguments to selector; cannot set"
^ self
].
recv := menuPanel receiver.
recv isValueModel ifTrue:[^ self].
recv isNil ifTrue:[
recv := menuPanel application.
recv isNil ifTrue:[^ self].
].
Object messageNotUnderstoodSignal handle:[:ex|
(ex parameter selector ~~ indication) ifTrue:[
ex reject
]
] do:[
numArgs == 1 ifTrue:[
recv perform:indication with:aValue
] ifFalse:[
recv perform:indication with:(argument ? self) with:aValue
]
].
!
indicatorForm
"returns indication form or nil
"
indication isNil ifTrue:[^ nil].
^ self indicationValue == true ifTrue:[menuPanel iconIndicationOn]
ifFalse:[menuPanel iconIndicationOff]
!
isEntered
"returns true if the mouse pointer is over the item
"
^ menuPanel enteredItem == self
"Created: / 20.8.1998 / 13:11:50 / cg"
!
reinitSubmenuStyle
"returns my submenu or nil
"
subMenu notNil ifTrue:[
subMenu reinitStyle
].
"Created: / 10.9.1998 / 21:36:09 / cg"
!
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
!
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.
"/ cg: linked menus also may contain translations ...
subm notNil ifTrue:[
appl notNil ifTrue:[
subm findGuiResourcesIn:appl.
]
].
].
self submenu:subm.
].
^ subMenu
"Modified: / 19.5.1998 / 19:36:56 / cg"
! !
!MenuPanel::Item methodsFor:'queries'!
canChangeVisibility
"return true if I am not always visible; can only be changed by a selector
otherwise there is a change notification raised if the model changed
"
^ isVisible isSymbol
"/ ^ isVisible notNil and:[isVisible ~~ true]
!
canSelect
"returns true if item is selectable; no separator, visible and enabled.
in case of a choice (RadioButton) i have to check for the choiceValue
"
(rawLabel notNil and:[self isVisible and:[self enabled]]) ifTrue:[
(choice isNil or:[choice value ~= choiceValue]) ifTrue:[
^ true
].
].
^ false
!
containsPointX:x y:y
"returns true if point is contained in my layout
"
(self isVisible and:[layout notNil]) ifTrue:[
^ layout containsPointX:x y:y
].
^ false
!
hasIndication
"returns true if on/off indication exists
"
^ indication notNil
!
hasSubmenu
"returns true if the item is configured as an subMenu entry
"
^ subMenu notNil or:[submenuChannel notNil]
!
isEnabled
"returns enabled state
"
^ self enabled
!
isLabeledItem
"returns true if the item is no button and no separator
"
^ rawLabel notNil and:[isButton not]
!
isSeparator
"returns true if item is a separator
"
^ rawLabel isNil
!
isVisible
"returns the visibility state
"
|state|
isVisible isSymbol ifTrue:[
state := self aspectAt:isVisible.
state isValueModel ifTrue:[
isVisible := state.
isVisible addDependent:self.
state := isVisible.
]
] ifFalse:[
state := isVisible
].
^ state value ~~ false
"Modified: / 5.10.1998 / 12:08:28 / cg"
!
isVisible:something
"change the state; if the state changed, a redraw is performed
"
|oldState newState|
isVisible isNil ifTrue:[
oldState := true
] ifFalse:[
oldState := isVisible value.
isVisible isValueModel ifTrue:[
isVisible removeDependent:self
]
].
isVisible := something.
isVisible isNil ifTrue:[
newState := true
] ifFalse:[
isVisible isValueModel ifTrue:[
isVisible addDependent:self
] ifFalse:[
isVisible isSymbol ifTrue:[^ self]
].
menuPanel shown ifFalse:[^ self].
newState := isVisible value.
].
newState ~~ oldState ifTrue:[
menuPanel mustRearrange
]
"Modified: / 5.10.1998 / 12:12:04 / cg"
!
shortcutKeyAsString
"converts shortcutKey to a text object
"
|nm prefix|
shortcutKey isNil ifTrue:[
^ nil
].
shortcutKey isCharacter ifTrue:[
nm := shortcutKey asString
] ifFalse:[
"/ this is somewhat complicated: we have the symbolic key at hand,
"/ but want to show the untranslated (inverse keyBoardMapped) key & modifier
"/ Ask the devices keyboardMap for the backtranslation.
nm := menuPanel device keyboardMap keyAtValue:shortcutKey ifAbsent:shortcutKey.
"/
"/ some modifier-key combination ?
"/
(nm startsWith:#Cmd) ifTrue:[
prefix := #Cmd.
] ifFalse:[(nm startsWith:#Alt) ifTrue:[
prefix := #Alt.
] ifFalse:[(nm startsWith:#Meta) ifTrue:[
prefix := #Meta.
] ifFalse:[(nm startsWith:#Ctrl) ifTrue:[
prefix := #Ctrl.
]]]].
prefix notNil ifTrue:[
nm := (self shortcutKeyPrefixFor:prefix), (nm copyFrom:(prefix size + 1))
] ifFalse:[
nm := nm asString
]
].
^ nm
"Modified: / 17.7.1998 / 11:56:40 / cg"
!
shortcutKeyPrefixFor:aModifier
"returns prefix assigned to a modifier
"
|m|
m := menuPanel device modifierKeyTopFor:aModifier.
m notNil ifTrue:[
^ m , '-'
].
^ aModifier , '-'.
"Modified: / 17.7.1998 / 11:56:46 / cg"
! !
!MenuPanel::Item methodsFor:'selection'!
isSelected
"returns true if item is selected
"
^ menuPanel selection == self
!
selected:isSelected
"change selection to a state. Dependant on the state open or hide an existing
submenu and perform a redraw
"
menuPanel isNil ifTrue:[
^ self hideSubmenu
].
isSelected ifFalse:[
self invalidate.
self hideSubmenu.
] ifTrue:[
menuPanel realized ifTrue:[
(indication isNil or:[isButton not]) ifTrue:[
self invalidate
].
(subMenu := self setupSubmenu) notNil ifTrue:[
self openSubmenu
]
]
].
! !
!MenuPanel class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.210 2000-02-25 16:58:56 ca Exp $'
! !
MenuPanel initialize!