"
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.
"
"{ Package: 'stx:libwidg2' }"
View subclass:#MenuPanel
instanceVariableNames:'adornment shadowView mapTime mustRearrange superMenu
shortKeyInset selection items groupSizes receiver enabled
lastActiveMenu enteredItem prevFocusView previousPointerGrab
previousKeyboardGrab relativeGrabOrigin hasImplicitGrap
scrollActivity rightArrowShadow rightArrow fgColor'
classVariableNames:'InitialSelectionQuerySignal DefaultAdornment Images
LigthenedImages'
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 font
keepLinkedMenu triggerOnDown horizontalLayout delayMenu'
classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
VerticalButtonInset LabelRightOffset VerticalPopUpInset'
poolDictionaries:''
privateIn:MenuPanel
!
Object subclass:#ScrollActivity
instanceVariableNames:'semaLock activeMenu scrollTask direction icons'
classVariableNames:''
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.
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.
Notice:
This is going to replace the obsolete MenuView.
[author:]
Claus Atzkern
[see also:]
Menu
MenuItem
MenuEditor
cg: this code is so ugly - needs a complete rewrite...
"
!
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]
[exBegin]
|top menu view item|
top := StandardSystemView extent:240@100.
menu := MenuPanel in:top.
menu labels:#( 'foo' 'Application' 'Clock' ).
menu verticalLayout:false.
menu subMenuAt:1 put:(MenuPanel labels:#( 'bar' 'baz' )).
menu subMenuAt:2 put:(MenuPanel labels:#( 'foo' 'bar' 'baz' )).
view := ClockView new.
view preferredExtent:100@100.
item := menu itemAt:3.
item submenu:view.
view := SimpleView new.
view client:(CodingExamples_GUI::GUIDemoExtendedComboBox new).
view preferredExtent:(400@50).
item := menu itemAt:2.
item submenu:view.
menu origin:0@0 corner:1.0@30.
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 receiver:aReceiver.
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.
(aMenu notNil and:[aMenu receiver isNil]) ifTrue:[
"/ no receiver specified in the menu; thus set the receiver immediately
mview receiver:aReceiver
].
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'!
iconIndicationDisabledOff
"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 iconIndicationDisabledOff inspect
ImageEditor openOnClass:self andSelector:#iconIndicationDisabledOff
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconIndicationDisabledOff'
ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUPG???8A:***@^*** G***(A:***@^*** G***(A:***@^*** G***(A:***@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]
!
iconIndicationDisabledOn
"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 iconIndicationDisabledOn inspect
ImageEditor openOnClass:self andSelector:#iconIndicationDisabledOn
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconIndicationDisabledOn'
ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'****$H@@@MBO???P#???4H??<=BO?<OP#O<C4H0<C=BL@C?P#0C?4H?C?=BO???P/???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]
!
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]
!
iconRadioGroupDisabledOff
"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 iconRadioGroupDisabledOff inspect
ImageEditor openOnClass:self andSelector:#iconRadioGroupDisabledOff
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconRadioGroupDisabledOff'
ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DJ*Y@DZ**(AJ**+AJ***LR***#D***(1J***LR***#AZ**#@Z**(0A** 0@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]
!
iconRadioGroupDisabledOn
"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 iconRadioGroupDisabledOn inspect
ImageEditor openOnClass:self andSelector:#iconRadioGroupDisabledOn
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel iconRadioGroupDisabledOn'
ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DJ*Y@DY@Z(AH@@+AI@@FLR@@@#D @@H1H@@BLRP@A#AX@@#@Z$A(0A** 0@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]
!
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'!
defaultBackgroundColor
^ StyleSheet at:#'menuPanel.backgroundColor'
!
defaultFont
^ StyleSheet at:#'menu.font'
!
defaultLevel
^ StyleSheet at:#'menuPanel.level'
!
mnemonicIdentifier
"returns the identifier each mnemonic starts with;
ex:
&File mnemonic := Cmdf
F&ile mnemonic := Cmdi
.....
"
^ 'Cmd'
!
updateStyleCache
<resource: #style (
#'popup.borderWidth' #'popup.level'
#'selection.disabledForegroundColor'
#'pullDownMenu.foregroundColor' #'pullDownMenu.backgroundColor' #'pullDownMenu.level'
#'menu.itemHorizontalSpace' #'menu.buttonItemHorizontalSpace' #'menu.buttonItemSpace'
#'menu.buttonItemVerticalSpace'
#'menu.buttonActiveLevel' #'menu.buttonPassiveLevel' #'menu.buttonEnteredLevel'
#'menu.hilightLevel' #'menu.enteredLevel'
#'menu.groupDividerSize' #'menu.itemMargin'
#'menu.disabledEtchedForegroundColor' #'menu.hilightForegroundColor'
#'menu.enteredBackgroundColor' #'menu.enteredForegroundColor'
#'menu.disabledForegroundColor' #'menu.buttonEnteredBackgroundColor'
#'menu.selectionFollowsMouse'
#'button.disabledEtchedForegroundColor' #'button.disabledForegroundColor'
#'button.activeBackgroundColor' #'button.backgroundColor' #'button.lightColor'
#'button.enteredBackgroundColor' #'button.halfLightColor' #'button.halfShadowColor'
#'button.activeLevel' #'button.passiveLevel' #'button.edgeStyle'
)>
|styleSheet style var foregroundColor backgroundColor buttonPassiveBackgroundColor
buttonActiveLevel buttonPassiveLevel buttonEnteredLevel|
"
self updateStyleCache
"
MenuView updateStyleCache.
SelectionInListView updateStyleCache.
styleSheet := StyleSheet.
style := styleSheet name.
foregroundColor := styleSheet colorAt:#'pullDownMenu.foregroundColor' default:Color black.
styleSheet at:#'menuPanel.foregroundColor' put:foregroundColor.
backgroundColor := styleSheet colorAt:#'pullDownMenu.backgroundColor' default:DefaultViewBackgroundColor.
styleSheet at:#'menuPanel.backgroundColor' put:backgroundColor.
var := styleSheet at:#'menu.buttonItemHorizontalSpace'.
var ifNil:[ var := styleSheet at:#'menu.buttonItemSpace' default:0 ].
styleSheet at:#'menuPanel.buttonInsetX' put:(var abs).
var := styleSheet at:#'menu.buttonItemVerticalSpace'.
var ifNil:[ var := styleSheet at:#'menu.buttonItemSpace' default:0 ].
styleSheet at:#'menuPanel.buttonInsetY' put:(var abs).
var := styleSheet at:#'menuPanel.level' default:nil.
var isNil ifTrue:[ var := styleSheet at:#'pullDownMenu.level' default:1 ].
styleSheet at:#'menuPanel.level' put:var.
var := styleSheet at:#'menu.itemHorizontalSpace'.
var ifNil:[ var := styleSheet at:#'menu.itemSpace' default:0 ].
styleSheet at:#'menuPanel.itemSpace' put:var.
var := styleSheet colorAt:#'menu.hilightBackgroundColor'.
var ifNil:[
style == #motif ifTrue:[ var := backgroundColor ]
ifFalse:[ var := styleSheet is3D ifFalse:[foregroundColor] ifTrue:[backgroundColor] ]
].
styleSheet at:#'menuPanel.activeBackgroundColor' put:var.
var := styleSheet colorAt:#'menu.disabledEtchedForegroundColor'.
var ifNil:[ var := styleSheet colorAt:#'button.disabledEtchedForegroundColor' ].
styleSheet at:#'menuPanel.disabledEtchedFgColor' put:var.
var := styleSheet colorAt:#'menu.disabledForegroundColor'.
var ifNil:[
var := styleSheet colorAt:#'selection.disabledForegroundColor'.
var ifNil:[ var := styleSheet colorAt:#'button.disabledForegroundColor' default:Color darkGray ]
].
styleSheet at:#'menuPanel.disabledForegroundColor' put:var.
var := styleSheet colorAt:#'menu.hilightForegroundColor'.
var ifNil:[ var := styleSheet is3D ifTrue:[foregroundColor] ifFalse:[backgroundColor] ].
styleSheet at:#'menuPanel.activeForegroundColor' put:var.
buttonActiveLevel := styleSheet at:#'menu.buttonActiveLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]).
buttonActiveLevel ifNil:[ buttonActiveLevel := styleSheet at:#'button.activeLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]) ].
styleSheet at:#'menuPanel.buttonActiveLevel' put:buttonActiveLevel.
buttonPassiveLevel := styleSheet at:#'menu.buttonPassiveLevel'.
buttonPassiveLevel ifNil:[ buttonPassiveLevel := styleSheet at:#'button.passiveLevel' default:(styleSheet is3D ifTrue:[2] ifFalse:[0])].
styleSheet at:#'menuPanel.buttonPassiveLevel' put:buttonPassiveLevel.
buttonEnteredLevel := styleSheet at:#'menu.buttonEnteredLevel' default:buttonPassiveLevel.
styleSheet at:#'menuPanel.buttonEnteredLevel' put:buttonEnteredLevel.
var := (buttonActiveLevel abs max:(buttonPassiveLevel abs)) max:(buttonEnteredLevel abs).
styleSheet at:#'menuPanel.maxAbsoluteButtonLevel' put:var.
buttonPassiveBackgroundColor := styleSheet at:#'button.backgroundColor'.
buttonPassiveBackgroundColor ifNil:[
buttonPassiveBackgroundColor := (styleSheet at:'viewBackground') ? backgroundColor
].
styleSheet at:#'menuPanel.buttonPassiveBackgroundColor' put:buttonPassiveBackgroundColor.
var := styleSheet at:#'button.lightColor'.
var ifNil:[ var := (buttonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) lightened ].
styleSheet at:#'menuPanel.buttonLightColor' put:var.
var := styleSheet at:#'button.shadowColor'.
var ifNil:[ var := (buttonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) darkened ].
styleSheet at:#'menuPanel.buttonShadowColor' put:var.
var := styleSheet colorAt:#'menu.buttonEnteredBackgroundColor'.
var ifNil:[ var := styleSheet colorAt:#'button.enteredBackgroundColor' default:buttonPassiveBackgroundColor ].
styleSheet at:#'menuPanel.buttonEnteredBackgroundColor' put:var.
Item updateStyleCache.
! !
!MenuPanel class methodsFor:'image registration'!
image:anImage onDevice:aDevice
"
Images := nil
"
|deviceImages image|
anImage device == aDevice ifTrue:[
^ anImage
].
Images isNil ifTrue:[ Images := WeakIdentityDictionary 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 := WeakIdentityDictionary 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:'a zeige claus'!
superMenu:aSuperMenu
"set my supermenu from which i'am activated
"
superMenu := aSuperMenu.
superMenu ifNotNil:[
styleSheet := superMenu styleSheet.
rightArrow := superMenu rightArrow.
rightArrowShadow := superMenu rightArrowShadow.
].
! !
!MenuPanel methodsFor:'accepting'!
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 acceptAction|
self superMenu notNil ifTrue:[
^ self topMenu accept:anItem
].
self openDelayed:nil.
self scrollActivity stop.
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.
].
"/ cg: disabled-not needed - try PopUpList with destroy...
"/ self destroy.
masterGroup notNil ifTrue:[masterGroup processExposeEvents].
].
acceptAction := [ value := self accept:item index:itemIdx toggle:tgState receiver:recv ].
(item notNil
and:[item showBusyCursorWhilePerforming
and:[(winGrp := (masterGroup ? (self windowGroup))) notNil]])
ifTrue:[
winGrp withWaitCursorDo:acceptAction
] ifFalse:[acceptAction value].
self isPopUpView ifTrue:[
self menuAdornmentAt:#value put:value.
self menuAdornmentAt:#item put:item.
].
^ item.
"Modified: / 15.11.2001 / 17:05:40 / 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
(value respondsTo:#valueWithArguments:) ifFalse:[
^ value
].
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 (or error in) 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 topMenu|
topMenu := self topMenu.
topMenu openDelayed:nil.
(anItem isNil or:[anItem hideMenuOnActivated]) ifTrue:[
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
"
|size|
self disabledRedrawDo:[
self removeAll.
size := labels size.
size > 0 ifTrue:[
items := OrderedCollection new:size.
labels do:[:aLabel| items add:(Item in:self label:aLabel) ]
]
].
!
menuPerformer:anObject
"set the menu-receiver. Thats the one who gets the messages ( both from myself and
from all submenus no specific receiver is defined ).
"
^ self receiver:anObject
!
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:aValueHolder
"set my enableChannel
"
enableChannel notNil ifTrue:[
enableChannel removeDependent:self
].
(enableChannel := aValueHolder) notNil ifTrue:[
enableChannel addDependent:self.
].
self enabled:(enableChannel value).
!
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
"
^ styleSheet colorAt:#'menuPanel.activeBackgroundColor'
!
activeForegroundColor
"get the foreground color used to highlight selections
"
^ styleSheet colorAt:#'menuPanel.activeForegroundColor'
!
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
"
^ styleSheet colorAt:#'button.activeBackgroundColor'
default:(self viewBackground)
!
buttonEdgeStyle
"get the button edge style
"
^ styleSheet at:#'button.edgeStyle'
!
buttonEnteredBackgroundColor
"get the background drawing color used to highlight entered button items
"
^ styleSheet colorAt:#'menuPanel.buttonEnteredBackgroundColor'
!
buttonEnteredLevel
"get the 3D-level used to highlight entered button items
"
^ styleSheet at:#'menuPanel.buttonEnteredLevel'
!
buttonHalfLightColor
"get the background drawing color used to half light button frame
"
^ styleSheet colorAt:#'button.halfLightColor'
!
buttonHalfShadowColor
"get the background drawing color used to half shadow button frame
"
^ styleSheet colorAt:#'button.halfShadowColor'
!
buttonLightColor
"get the background drawing color used to light button frame
"
^ styleSheet colorAt:#'menuPanel.buttonLightColor'
!
buttonPassiveBackgroundColor
"get the background drawing color used for button
"
^ styleSheet colorAt:#'menuPanel.buttonPassiveBackgroundColor'
!
buttonShadowColor
"get the background drawing color used to shadow button frame
"
^ styleSheet colorAt:#'menuPanel.buttonShadowColor'
!
disabledEtchedForegroundColor
"return the color used for etching disabled items.
If nil, no 3D effect is drawn.
"
^ styleSheet colorAt:#'menuPanel.disabledEtchedFgColor'
!
disabledForegroundColor
"return the foreground color used by disabled items
"
^ styleSheet colorAt:#'menuPanel.disabledForegroundColor'
!
enteredBackgroundColor
"return the background color for entered items
"
^ styleSheet colorAt:#'menu.enteredBackgroundColor'
default:(self backgroundColor)
!
enteredForegroundColor
"return the foreground color for entered items
"
^ styleSheet colorAt:#'menu.enteredForegroundColor' default:fgColor
!
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.
"
aColor ~= fgColor ifTrue:[
fgColor := aColor onDevice:device.
shown ifTrue:[ self invalidate ]
].
!
maxAbsoluteButtonLevel
"returns the maximum absolute button level; used to compute the preferred
extent of a button
"
^ styleSheet at:#'menuPanel.maxAbsoluteButtonLevel'
!
selectionFrameBrightColor
"get the selection frame bright color
"
^ Color white
!
selectionFrameDarkColor
"get the selection frame dark color
"
^ Color black
!
setFont:aFont
"set the font derived from item; if unchanged nil is returned otherwise the old font
"
|currentFont|
(aFont notNil and:[aFont ~= font]) ifTrue:[
currentFont := font.
super font:aFont.
].
^ currentFont
! !
!MenuPanel methodsFor:'accessing-dimensions'!
height
"default height
"
(explicitExtent ~~ true) ifTrue:[
^ self preferredExtent y
].
^ super height
!
maxExtent
"CLAUS: returns the maximum extent
"
|x y|
device isNil ifTrue:[
superMenu notNil ifTrue:[
^ superMenu maxExtent
].
].
y := device usableHeight - 2.
x := device usableWidth - 2.
^ x@y
!
preferredExtent
"compute and returns my preferred extent
"
|maxExtent usedExtent w|
preferredExtent notNil ifTrue:[
^ preferredExtent
].
maxExtent := self maxExtent.
usedExtent := self preferredExtentOfItems.
superView isNil ifTrue:[
"/ is standalone
w := self menuAdornmentAt:#Width.
w notNil ifTrue:[
usedExtent x < w ifTrue:[
usedExtent := w @ usedExtent y.
]
]
].
^ usedExtent min:maxExtent
"Modified: / 10.10.2001 / 14:57:25 / cg"
!
preferredExtentOfItems
"compute and returns my preferred extent including all items
!!!!!! changes have influence on method #rearrangeItems !!!!!!
"
|hasMenu shCtKey extent showAcc sck
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
buttonInsetX "{ Class:SmallInteger }"
buttonInsetY "{ Class:SmallInteger }"
labelInsetX "{ Class:SmallInteger }"
labelInsetY "{ Class:SmallInteger }"
itemSpace "{ Class:SmallInteger }"
itemMargin "{ Class:SmallInteger }"
groupDividerSize "{ Class:SmallInteger }"
|
(size := items size) == 0 ifTrue:[
self isViewWrapper ifTrue:[ ^ subViews first extent ].
^ 32 @ 32
].
buttonInsetX := 2 * self buttonInsetX.
buttonInsetY := 2 * self buttonInsetY.
self isPopUpView ifFalse:[
labelInsetX := labelInsetY := 2 * (self enteredLevel abs).
] ifTrue:[
labelInsetX := labelInsetY := 0.
].
x := 0.
y := 0.
groupDividerSize := self groupDividerSize.
self verticalLayout ifFalse:[
itemSpace := self itemSpace.
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 + buttonInsetX.
eY := eY + buttonInsetY.
] ifFalse:[
eX := eX + labelInsetX.
eY := eY + labelInsetY.
].
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.
itemMargin := 2 * self itemMargin.
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 + buttonInsetX.
eY := eY + buttonInsetY.
] ifFalse:[
eX := eX + labelInsetX.
eY := eY + labelInsetY.
].
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
]
].
y := eY + y.
x := eX max:x.
].
].
x := x + itemMargin.
(hasMenu or:[shCtKey ~~ 0]) ifTrue:[
shortKeyInset := x + Item labelRightOffset.
x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
(shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
x := x + self shortcutKeyOffset.
]
].
"/ to have a small inset
y := y + 1.
"/ x := x + 1.
].
x := x + margin + margin.
y := y + margin + margin.
^ x @ y
!
preferredWidth:aWidth
self menuAdornmentAt:#Width put:aWidth.
"Created: / 10.10.2001 / 14:56:39 / cg"
!
shortKeyInset
"left inset of shortcutKey
"
^ shortKeyInset
!
subMenuIndicationWidth
^ self rightArrow width
! !
!MenuPanel methodsFor:'accessing-interactors'!
iconIndicationDisabledOff
^ self registerImageOnDevice:(self class iconIndicationDisabledOff)
!
iconIndicationDisabledOn
^ self registerImageOnDevice:(self class iconIndicationDisabledOn)
!
iconIndicationOff
^ self registerImageOnDevice:(self class iconIndicationOff)
!
iconIndicationOn
^ self registerImageOnDevice:(self class iconIndicationOn)
!
iconRadioGroupDisabledOff
^ self registerImageOnDevice:(self class iconRadioGroupDisabledOff)
!
iconRadioGroupDisabledOn
^ self registerImageOnDevice:(self class iconRadioGroupDisabledOn)
!
iconRadioGroupOff
^ self registerImageOnDevice:(self class iconRadioGroupOff)
!
iconRadioGroupOn
^ self registerImageOnDevice:(self class 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
"
^ styleSheet at:#'menuPanel.buttonActiveLevel'
!
buttonPassiveLevel
"get the button active level
"
^ styleSheet at:#'menuPanel.buttonPassiveLevel'
!
fitFirstPanel
"gets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
NOT SUPPORTED
"
^ false
!
fitFirstPanel:aState
"sets true if the first panel in the menu hierarchy must be fit
to the extent of its superView
NOT SUPPORTED
"
!
level:anInt
anInt ~~ level ifTrue:[
super level:anInt.
self mustRearrange
]
"Modified: / 15.11.2001 / 17:42:07 / cg"
!
rightArrow
rightArrow ifNil:[
device ifNil:[
^ SelectionInListView rightArrowFormOn:Display
].
rightArrow := SelectionInListView rightArrowFormOn:device
].
^ 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 )
"
|direction|
direction := self menuAdornmentAt:#verticalLayout.
direction notNil ifTrue:[^ direction].
self isPopUpView ifTrue:[^ true].
^ superMenu notNil
!
verticalLayout:aState
"set the layout: or vertical( true ) or horizontal( false )
"
(self menuAdornmentAt:#verticalLayout put:aState) ifTrue:[
self mustRearrange
]
! !
!MenuPanel methodsFor:'accessing-style'!
buttonInsetX
"returns the verical button space
"
^ styleSheet at:#'menuPanel.buttonInsetX'
!
buttonInsetY
"returns the verical button space
"
^ styleSheet at:#'menuPanel.buttonInsetY'
!
enteredLevel
"returns the enter-level for an unselected item moved through
"
^ styleSheet at:#'menu.enteredLevel' default:0
!
groupDividerSize
"returns the width of a group divider
"
^ styleSheet at:#'menu.groupDividerSize' default:6
!
itemMargin
"returns the margin of an item
"
^ styleSheet at:#'menu.itemMargin' default:0
!
itemSpace
"returns the additional space for an item in a (vertical) panel
"
^ styleSheet at:#'menuPanel.itemSpace'
!
selectionFollowsMouse
"returns true if the selection follows the mouse
"
^ styleSheet at:#'menu.selectionFollowsMouse' default:false
!
shortcutKeyOffset
"returns the offset for a shortcutKey
"
^ 5
! !
!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'!
closeMenus
"close all menus; operation is done; nothing accepted
"
self topMenu accept:nil.
!
hide
"hide the view, leave its modal event loop
"
self selection:nil.
self unmap.
!
show
"realize the view at its last position;
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ self showAt:(self origin) resizing:true
!
showAt:aPoint
"realize the view at aPoint.
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ 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.
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ self showAt:(device pointerPosition) resizing:true
!
showCenteredIn:aView
"make myself visible at the screen center.
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
|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
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ self showAtPointer
!
startUpAt:aPoint
"realize the menu at aPoint
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ self showAt:aPoint
"Created: / 21.5.1998 / 14:15:57 / cg"
!
startUpOrNil
"realize the menu at the current pointer position
return the value of the selectedItem or nil, of none was selected
(unless the menu has already performed its action, by sending an appropriate message
to some performer)
"
^ self showAtPointer
! !
!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 is returned.
"
|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.
items notNil ifTrue:[
items copy do:[:el| el destroy ].
].
items := nil
].
"Modified: / 15.11.2001 / 17:02:51 / cg"
! !
!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 menuReceiver|
self removeAll.
(menu := aMenu) notNil ifTrue:[
(aMenu isCollection) ifTrue:[
menu := Menu new.
menu fromLiteralArrayEncoding:aMenu.
] ifFalse:[
menuReceiver := menu receiver.
menuReceiver notNil ifTrue:[
receiver := menuReceiver.
]
].
(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:(self buttonShadowColor)
light:(self buttonLightColor)
halfShadow:(self buttonHalfShadowColor)
halfLight:(self buttonHalfLightColor)
style:(self buttonEdgeStyle)
]
]
!
drawItemsX:x y:y width:w height:h
"redraw items and groups in a damage
"
|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 }"
|
size := items size.
isVertical := self verticalLayout.
isVertical ifTrue:[
start := items findFirst:[:el| |l| l := el layout. l notNil and:[l bottom > y]].
start == 0 ifTrue:[ ^ self ].
y1 := y + h.
stop := items findFirst:[:el| |l| l := el layout. l notNil and:[l top > y1] ]
startingAt:(start + 1).
] ifFalse:[
start := items findFirst:[:el| |l| l := el layout. l notNil and:[l right > x ]].
start == 0 ifTrue:[ ^ self ].
x1 := x + w.
stop := items findFirst:[:el| |l| l := el layout.l notNil and:[l left > x1]]
startingAt:(start + 1).
].
stop == 0 ifTrue:[stop := size] ifFalse:[stop := stop - 1].
(groupSizes size ~~ 0 and:[self showGroupDivider]) ifTrue:[
groupDivInset := self 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.
!
drawLabelEdgeFor:anItem selected:isSelected
|level layout|
isSelected ifTrue:[
level := styleSheet at:#'menu.hilightLevel' default:0.
] ifFalse:[
anItem == enteredItem ifTrue:[ level := self enteredLevel ]
ifFalse:[ level := 0 ]
].
level ~~ 0 ifTrue:[
layout := anItem layout.
self drawEdgesForX:(layout left)
y:(layout top)
width:(layout width)
height:(layout height)
level:level
].
!
drawScrollerAt:aDirection bounds:bounds
"draw a scroller
"
|scrolling icon level x y w h|
x := bounds left.
y := bounds top.
w := bounds width.
h := bounds height.
scrolling := self scrollActivity.
(scrolling activeMenu == self and:[scrolling direction == aDirection]) ifTrue:[
level := -2
] ifFalse:[
level := 1
].
level ~~ 0 ifTrue:[
self drawEdgesForX:x y:y width:w height:h level:level.
].
icon := scrolling iconAt:aDirection on:self.
icon displayOn:self x:(x + (w - icon width // 2))
y:(y + (h - icon height // 2)).
!
invalidateItem:anItem repairNow:aBool
"an item changed; invalidate the items layout
"
|layout|
self sensor isNil ifTrue:[^ self].
(mustRearrange not and:[shown]) ifTrue:[
layout := anItem layout.
(layout bottom > margin and:[layout top < (height - margin)]) ifTrue:[
self invalidate:(layout copy insetBy:-1) repairNow:aBool
]
].
"Modified: / 29.2.2000 / 11:28:59 / cg"
!
mustRearrange
"force rearrange (i.e. set the rearrange flag)
"
mustRearrange 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 #preferredExtentOfItems !!!!!!
"
|isVertical extent isPopUpMenu
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
insetX "{ Class:SmallInteger }"
insetY "{ Class:SmallInteger }"
labelInsetX "{ Class:SmallInteger }"
labelInsetY "{ Class:SmallInteger }"
buttonInsetX "{ Class:SmallInteger }"
buttonInsetY "{ Class:SmallInteger }"
itemMargin "{ Class:SmallInteger }"
itemSpace "{ Class:SmallInteger }"
groupDividerSize "{ Class:SmallInteger }"
|
(mustRearrange and:[(size := items size) ~~ 0]) ifFalse:[
mustRearrange := false.
^ self
].
"/ DON'T SET THIS!!
"/ item layout: below of first item -> item invalidate
"/ -> menuPanel invalidateItem:repairDamage:
"/ -> invalidate:rapairDamage:
"/ -> redrawX:y:width:height:
"/ tries to get uninitialized layout from second item.
"/ This happens in a modal debugger!!
"/ mustRearrange := false.
isVertical := self verticalLayout.
itemSpace := self itemSpace.
groupDividerSize := self groupDividerSize.
buttonInsetX := self buttonInsetX.
buttonInsetY := self buttonInsetY.
isPopUpMenu := self isPopUpView.
isPopUpMenu ifFalse:[
labelInsetX := labelInsetY := self enteredLevel abs.
] ifTrue:[
labelInsetX := labelInsetY := 0
].
(isPopUpMenu or:[explicitExtent ~~ true]) ifTrue:[ |savExt maxExt|
savExt := extent := self preferredExtent copy.
isPopUpMenu ifFalse:[
isVertical ifTrue:[extent y:1.0] ifFalse:[extent x:1.0]
] ifTrue:[
savExt := extent copy.
maxExt := self maxExtent.
isVertical ifTrue:[
extent y:(extent y min:(maxExt y))
] ifFalse:[
extent x:(extent x min:(maxExt x))
]
].
self extent:extent.
extent := savExt.
] 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:[
insetX := buttonInsetX.
insetY := buttonInsetY.
] ifFalse:[
insetX := labelInsetX.
insetY := labelInsetY.
].
x0 := x + insetX.
x1 := x0 + (el preferredExtent x).
el layout:(Rectangle left:x0 top:(y0 + insetY) right:x1 bottom:(y1 - insetY)).
x := x1 + insetX.
size ~~ anIndex ifTrue:[
(self hasGroupDividerAt:anIndex) ifTrue:[
x := x + groupDividerSize
] ifFalse:[
el isLabeledItem ifTrue:[
x := x + itemSpace
]
]
]
].
].
] ifTrue:[
itemMargin := self itemMargin.
x0 := margin.
x1 := extent x - margin - itemMargin. "/ -1
items keysAndValuesDo:[:anIndex :el|
el isVisible ifFalse:[
el layout:(Rectangle left:x0 top:y right:x1 bottom:y)
] ifTrue:[
el isButton ifTrue:[
insetX := buttonInsetX.
insetY := buttonInsetY.
] ifFalse:[
insetX := labelInsetX.
insetY := labelInsetY.
].
y0 := y + insetY.
y1 := y0 + el preferredExtent y.
el layout:(Rectangle left:(x0 + insetX + itemMargin) top:y0 right:(x1 - insetX) bottom:y1).
y := y1 + insetY.
size ~~ anIndex ifTrue:[
(self hasGroupDividerAt:anIndex) ifTrue:[
y := y + groupDividerSize
]
]
]
]
].
self rearrangeGroups.
selection notNil ifTrue:[self makeItemVisible:selection].
mustRearrange := false.
"Modified: / 13.11.2001 / 20:17:21 / cg"
!
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 damage
"
|y0 y1 x0 x1 bounds mustDrawPrevScroller mustDrawNextScroller|
(shown and:[w ~~ 0]) ifFalse:[^ self].
mustRearrange ifTrue:[
self isPopUpView not ifTrue:[explicitExtent := true].
self rearrangeItems.
^ self invalidate
].
self paint:(self viewBackground).
self clearRectangleX:x y:y width:w height:h.
items size == 0 ifTrue:[
^ self
].
y0 := y.
y1 := y + h.
x0 := x.
x1 := x + w.
self hasScrollers ifTrue:[
(self hasScrollerAt:#PREV) ifTrue:[
bounds := self scrollerBoundsAt:#PREV.
mustDrawPrevScroller := false.
self verticalLayout ifTrue:[
bounds bottom > y ifTrue:[
y0 := bounds bottom.
mustDrawPrevScroller := true.
].
] ifFalse:[
bounds right > x ifTrue:[
x0 := bounds right.
mustDrawPrevScroller := true.
].
].
mustDrawPrevScroller ifTrue:[
self drawScrollerAt:#PREV bounds:bounds.
].
].
(self hasScrollerAt:#NEXT) ifTrue:[
bounds := self scrollerBoundsAt:#NEXT.
mustDrawNextScroller := false.
self verticalLayout ifTrue:[
bounds top < y1 ifTrue:[
y1 := bounds top.
mustDrawNextScroller := true.
]
] ifFalse:[
bounds left < x1 ifTrue:[
x1 := bounds left.
mustDrawNextScroller := true.
]
].
mustDrawNextScroller ifTrue:[
self drawScrollerAt:#NEXT bounds:bounds.
].
]
].
(y1 > y0 and:[x1 > x0]) ifTrue:[
self drawItemsX:x0 y:y0 width:(x1 - x0) height:(y1 - y0)
].
"Modified: / 15.11.2001 / 20:57:32 / 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 motionPoint translatedPoint sensor|
self scrollActivity isActive ifTrue:[
^ self
].
sensor := self sensor.
(sensor isNil or:[sensor hasButtonMotionEventFor:nil]) ifTrue:[
^ self
].
menue := self detectGrabMenu.
motionPoint := x@y.
translatedPoint := menue translateGrabPoint:motionPoint.
menue handleButtonMotion:state atPoint:translatedPoint.
(self isPopUpView or:[sensor anyButtonPressed]) ifTrue:[
^ self
].
(selection notNil and:[selection visibleSubmenu isNil]) ifTrue:[
"/ selection on grabView withou a submenu (Button ...); check whether moving out
(self containsPoint:motionPoint) ifFalse:[
^ self accept:nil
]
].
"Modified: / 13.11.2001 / 20:21:49 / cg"
!
buttonMultiPress:button x:x y:y
"/ self buttonPress:button x:x y:y
!
buttonPress:button x:x y:y
"any button pressed; open or close the corresponding submenus
"
|menu point|
self scrollActivity stop.
point := x@y.
menu := self detectMenuAtGrabPoint:point.
menu isNil ifTrue:[
"/ self accept:nil
] ifFalse:[
point := menu translateGrabPoint:point.
menu handleButtonPressAtPoint:point.
]
"Modified: / 13.11.2001 / 14:12:32 / cg"
!
buttonRelease:button x:x y:y
"button release action; accept selection and close all views
"
|topMenu dstMenu item srcPoint dstPoint subm|
topMenu := self topMenu.
topMenu openDelayed:nil.
self scrollActivity stop ifTrue:[
^ self
].
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 visibleSubmenu notNil ifTrue:[
dstMenu selection:nil.
(selection isNil and:[self isPopUpView not]) ifTrue:[
self accept:nil
].
^ self
].
subm := item currentSubmenu.
subm ifNotNil:[
subm shown ifTrue:[^ self].
"/ test whether any action is assigned to the menu
"/ if not ignorre accept
item hasDelayedMenu ifFalse:[^ self].
"/ handle action defined for the delayed menu
].
dstPoint := dstMenu translateGrabPoint:srcPoint.
(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)) == dstMenu selection ifFalse:[
item := nil
].
topMenu acceptItem:item inMenu:dstMenu.
^ self
].
(selection notNil and:[dstMenu == self]) ifTrue:[
selection visibleSubmenu notNil ifTrue:[
^ self
]
].
self accept:nil.
].
!
keyPress:key x:x y:y
"any key is pressed
"
|menu|
self scrollActivity isActive ifTrue:[
key ~~ #Escape ifTrue:[
^ self
].
self scrollActivity stop
].
(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
]
] ifFalse:[
menu isViewWrapper ifFalse:[
self sensor compressKeyPressEventsWithKey:key.
menu handleKeyPress:key.
"/ selection isNil ifTrue:[
"/ self accept:nil keepValue:true
"/ ]
] ifTrue:[
]
].
!
pointerLeave:state
self scrollActivity isActive ifTrue:[^ self].
self detectGrabMenu handlePointerLeave:state.
self isPopUpView ifTrue:[
^ self
].
(selection notNil and:[selection hasSubmenu not]) ifTrue:[
"/ selection on grabView withou a submenu (Button ...); check whether moving out
"/ self sensor anyButtonPressed ifFalse:[
self accept:nil.
"/ ].
].
!
sizeChanged:how
"redraw #right groups
"
self isPopUpView ifFalse:[
mustRearrange := true.
shown ifTrue:[
self invalidate
]
].
super sizeChanged:how
! !
!MenuPanel methodsFor:'event handling processing'!
clearImplicitGrab
self menuAdornmentAt:#implicitGrabView put:nil.
self menuAdornmentAt:#lastPointerView put:nil.
!
dispatchEvent:ev withFocusOn:focusView delegate:doDelegate
"dispatch and handle an event
"
|view x y p syntheticEvent implicitGrabView lastPointerView menu|
implicitGrabView := self menuAdornmentAt:#implicitGrabView.
"/ situation: we get a buttonPress, set implicitGrab (for scrollbars etc.)
"/ but never get the buttonRelease, since someone else (a popUp) grabbed the
"/ pointer in the meantime, and has eaten the release event ... (double-sigh)
implicitGrabView notNil ifTrue:[
self sensor leftButtonPressed ifFalse:[
self clearImplicitGrab.
].
].
((x := ev x) isNil or:[(y := ev y) isNil]) ifTrue:[
^ super dispatchEvent:ev withFocusOn:focusView delegate:false.
].
implicitGrabView notNil ifTrue:[
ev isButtonEvent ifTrue:[
p := device translatePoint:(x@y) fromView:self toView:implicitGrabView.
ev view:implicitGrabView.
ev arguments at:2 put:p x.
ev arguments at:3 put:p y.
implicitGrabView dispatchEvent:ev withFocusOn:focusView delegate:false.
ev isButtonReleaseEvent ifTrue:[
self clearImplicitGrab.
].
^ self
]
].
menu := self detectMenuAtGrabPoint:(x@y).
(menu isNil or:[menu isViewWrapper not]) ifTrue:[
self clearImplicitGrab.
^ super dispatchEvent:ev withFocusOn:focusView delegate:false
].
p := menu translateGrabPoint:(x@y).
view := self detectViewAtX:(p x) y:(p y) in:menu.
p := device translatePoint:(x@y) fromView:self toView:view.
ev isButtonPressEvent ifTrue:[
(view wantsFocusWithButtonPress) ifTrue:[
view requestFocus.
].
view ~~ self ifTrue:[ "/ can this ever be self ?
self menuAdornmentAt:#implicitGrabView put:view.
]
].
lastPointerView := self menuAdornmentAt:#lastPointerView.
ev isButtonMotionEvent ifTrue:[
lastPointerView ~~ view ifTrue:[
"/ must generate enter/leave ... (sigh)
lastPointerView notNil ifTrue:[
"/ XXX: should be fixed
syntheticEvent := WindowEvent pointerLeave:0 view:lastPointerView.
lastPointerView dispatchEvent:syntheticEvent withFocusOn:nil delegate:false.
].
view notNil ifTrue:[
syntheticEvent := WindowEvent pointerEnter:0 x:x y:y view:view.
view dispatchEvent:syntheticEvent withFocusOn:nil delegate:false.
].
self menuAdornmentAt:#lastPointerView put:view.
].
].
ev view:view.
ev x:p x.
ev y:p y.
view dispatchEvent:ev withFocusOn:focusView delegate:false.
"Modified: / 10.10.2001 / 13:54:47 / cg"
!
handleButtonMotion:state atPoint:motionPoint
"open or close the corresponding submenus
"
|menu translatedPoint sel|
(state == 0 or:[self sensor anyButtonPressed not]) ifTrue:[
"/ highlight enterItem if no selection exists
selection isNil ifTrue:[
(self containsPoint:motionPoint) ifTrue:[
((sel := self itemAtPoint:motionPoint) isNil or:[sel canSelect not]) ifTrue:[
^ self pointerEntersItem:nil
].
(superMenu notNil and:[self selectionFollowsMouse]) ifTrue:[
self selection:sel openMenu:true.
] ifFalse:[
self pointerEntersItem:sel
].
^ self
].
].
self pointerEntersItem:nil.
( self selectionFollowsMouse
and:[(menu := self superMenuAtPoint:motionPoint) notNil]
) ifTrue:[
translatedPoint := self translateMenuPoint:motionPoint toMenu:menu.
sel := menu itemAtPoint:translatedPoint.
(sel notNil and:[sel canSelect]) ifTrue:[
menu selection:sel openMenu:true.
]
].
^ self
].
self pointerEntersItem:nil.
(menu := self superMenuAtPoint:motionPoint) isNil ifTrue:[
self isPopUpView ifTrue:[
self selection:nil
].
^ self
].
menu == self ifTrue:[
(sel := self itemAtPoint:motionPoint) notNil ifTrue:[
self selection:sel openMenu:true.
].
] ifFalse:[
translatedPoint := self translateMenuPoint:motionPoint toMenu:menu.
sel := menu itemAtPoint:translatedPoint.
(sel isNil and:[menu isPopUpView not]) ifTrue:[
sel := menu selection.
].
menu selection:sel openMenu:true.
]
"Created: / 13.11.2001 / 20:21:24 / cg"
"Modified: / 13.11.2001 / 20:26:32 / cg"
!
handleButtonPressAtPoint:aPoint
"a button pressed; open or close the corresponding submenus
"
| item sensor direction|
item := self itemAtPoint:aPoint.
item notNil ifTrue:[
direction := self scrollerDirectionAtPoint:aPoint.
direction notNil ifTrue:[
(self scrollActivity startIfRequiredAt:direction on:self) ifTrue:[
self pointerEntersItem:nil.
^ self
]
]
].
self selection:item openMenu:true.
item isNil ifTrue:[^ self].
item hasDelayedMenu ifTrue:[^ self].
(item isToggle or:[item triggerOnDown]) ifFalse:[
^ self
].
(item canAccept and:[item == self selection]) ifFalse:[
^ self
].
self invalidateItem:item repairNow:true.
self acceptItem:item inMenu:self.
(sensor := self sensor) notNil ifTrue:[
[sensor anyButtonPressed] whileTrue:[ Delay waitForSeconds:0.1 ].
sensor flushUserEvents.
].
self selection:nil.
"Created: / 13.11.2001 / 14:12:04 / cg"
"Modified: / 13.11.2001 / 19:50:52 / cg"
!
handleCursorKey:aKey
"handle a cursor key
"
|next menu item isVrt backKey p1 p2
idx "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
(size := items size) == 0 ifTrue:[
superMenu notNil ifTrue:[superMenu handleCursorKey:aKey].
^ self
].
isVrt := self verticalLayout.
( (isVrt and:[aKey == #CursorUp or:[aKey == #CursorDown]])
or:[(isVrt not and:[aKey == #CursorRight or:[aKey == #CursorLeft]])]
) ifTrue:[
selection isNil ifTrue:[
(superMenu notNil and:[superMenu verticalLayout == isVrt]) ifTrue:[
^ superMenu handleCursorKey:aKey
].
idx := 0.
isVrt ifTrue:[
"/ used because of vertical scrolling
idx := items findFirst:[:el| el layout top > 0 ].
idx ~~ 0 ifTrue:[idx := idx := idx - 1 ]
].
] ifFalse:[
idx := self indexOf:selection.
].
next := aKey == #CursorRight or:[aKey == #CursorDown].
size timesRepeat:[|el|
next ifTrue:[(idx := idx + 1) > size ifTrue:[idx := 1]]
ifFalse:[(idx := idx - 1) < 1 ifTrue:[idx := size]].
(el := items at:idx ifAbsent:nil) notNil ifTrue:[
el canSelect ifTrue:[
el hasDelayedMenu ifTrue:[
"/ do not open menu
self selection:el openMenu:false
] ifFalse:[
"/ open comes from style-sheet
self selection:el.
].
^ self
].
]
].
^ self
].
superMenu notNil ifTrue:[
p1 := self translateGrabPoint:0.
p2 := superMenu translateGrabPoint:0.
].
isVrt ifTrue:[
(superMenu notNil and:[p1 x > p2 x]) ifTrue:[
backKey := #CursorRight
] ifFalse:[
backKey := #CursorLeft.
]
] ifFalse:[
(superMenu notNil and:[p1 y > p2 y]) ifTrue:[
backKey := #CursorDown
] ifFalse:[
backKey := #CursorUp.
]
].
aKey == backKey ifTrue:[
superMenu isNil ifTrue:[
self accept:nil
] ifFalse:[
superMenu verticalLayout ~~ isVrt ifTrue:[
superMenu handleCursorKey:aKey
] ifFalse:[
superMenu selection hideSubmenu
]
].
^ self
].
selection isNil ifTrue:[
superMenu isNil ifTrue:[^ self accept:nil].
superMenu verticalLayout ~~ isVrt ifTrue:[
superMenu handleCursorKey:aKey
] ifFalse:[
(item := items findFirst:[:el| el canSelect]) notNil ifTrue:[
self selectionIndex:item
]
].
^ self
].
selection hasSubmenu ifTrue:[
(menu := selection visibleSubmenu) isNil ifTrue:[
selection toggleSubmenuVisibility
] ifFalse:[
menu selectionIndex:1
]
] ifFalse:[
superMenu notNil ifTrue:[
superMenu verticalLayout ~~ isVrt ifTrue:[
superMenu handleCursorKey:aKey
]
] ifFalse:[
self accept:nil
]
].
!
handleKeyPress:key
"any key is pressed
"
|item inMenu|
(key == #Return or:[key == Character space]) ifTrue:[
self handleReturnPressed
] ifFalse:[
key isCharacter ifTrue:[
"/ selection notNil ifTrue:[
"/ inMenu := self
"/ ] ifFalse:[
"/ (inMenu := superMenu) isNil ifTrue:[^ self].
"/ ].
inMenu := self.
(item := inMenu detectItemForKey:key) notNil ifTrue:[
inMenu selection:item
]
] ifFalse:[
( key == #CursorDown or:[key == #CursorUp
or:[key == #CursorLeft or:[key == #CursorRight]]]
) ifTrue:[
self handleCursorKey:key
]
]
]
!
handlePointerLeave:state
self pointerEntersItem:nil.
super pointerLeave:state
!
handleReturnPressed
"any key is pressed
"
|sensor subm item|
(item := selection) isNil ifTrue:[
superMenu notNil ifTrue:[
item := superMenu selection.
item value notNil ifTrue:[
"/ is a delayed menu
self accept:item
] ifFalse:[
item toggleSubmenuVisibility
]
] ifFalse:[
self accept
].
^ self
].
selection hasSubmenu ifTrue:[
selection hasDelayedMenu ifFalse:[
selection toggleSubmenuVisibility.
^ self
].
subm := selection currentSubmenu.
(subm notNil and:[subm shown]) ifTrue:[
selection toggleSubmenuVisibility.
^ self
].
self openDelayed:nil
].
self accept.
" test for toggle "
item isToggle ifTrue:[
self selection:item.
] ifFalse:[
(selection notNil and:[selection triggerOnDown]) ifFalse:[
^ self
]
].
(sensor := self sensor) isNil ifTrue:[
^ self
].
[ sensor flushKeyboardFor:nil.
Delay waitForSeconds:0.1.
sensor hasKeyPressEventFor:nil.
] whileTrue.
!
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:[
( self buttonEnteredBackgroundColor ~= self buttonPassiveBackgroundColor
or:[self buttonEnteredLevel ~= self buttonPassiveLevel]
) ifTrue:[
newItem := anItemOrNil
]
] ifFalse:[
(self enteredLevel ~~ 0
or:[self enteredBackgroundColor ~= self backgroundColor]
) 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.
self clearImplicitGrab.
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'!
flyByHelpTextAt: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 (ignoring the given point).
"
|dstMenu dstPoint|
dstMenu := self detectMenuAtGrabPoint:srcPoint.
dstMenu isNil ifTrue:[^ nil].
dstPoint := dstMenu translateGrabPoint:srcPoint.
^ dstMenu flyByHelpTextForItem:(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)).
!
flyByHelpTextForItem:anItem
"returns the helpText for an item (empty if none)
"
|key app|
anItem isNil ifTrue:[^ nil].
anItem isButton ifFalse:[^ nil].
key := anItem activeHelpKey.
key isNil ifTrue:[^ nil].
app := self application.
app isNil ifTrue:[^ nil].
^ app flyByHelpTextForKey:key.
!
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"
!
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.
items notNil ifTrue:[items copy do:[:el|el destroy]].
items := nil.
menuHolder notNil ifTrue:[menuHolder removeDependent:self].
enableChannel notNil ifTrue:[enableChannel removeDependent:self].
super destroy.
superMenu := nil.
shadowView notNil ifTrue:[shadowView destroy].
"Modified: / 15.11.2001 / 17:08:45 / cg"
!
fetchDeviceResources
"fetch device colors, to avoid reallocation at redraw time
"
|style|
superMenu ifNotNil:[
styleSheet := superMenu styleSheet
].
super fetchDeviceResources.
"/ thats a kludge - will be replaced by values from the styleSheet ...
"/ (i.e. read menu.buttonActiveLevel & menu.buttonPassiveLevel)
superMenu isNil ifTrue:[
rightArrow ifNil:[
rightArrow := SelectionInListView rightArrowFormOn:device.
].
fgColor := fgColor onDevice:device.
style := styleSheet name.
(style ~~ #os2 and:[style ~~ #win95]) ifTrue:[
rightArrowShadow := SelectionInListView rightArrowShadowFormOn:device
] ifFalse:[
rightArrowShadow := nil
].
] ifFalse:[
rightArrow := superMenu rightArrow.
rightArrowShadow := superMenu rightArrowShadow.
self foregroundColor:(superMenu foregroundColor).
self font:(superMenu font).
self viewBackground:(superMenu viewBackground).
].
items notNil ifTrue:[
items do:[:eachItem| eachItem fetchDeviceResources ]
].
"Modified: / 15.9.1998 / 12:51:29 / cg"
!
initStyle
"initialize style specific stuff"
super initStyle.
viewBackground := styleSheet colorAt:#'menuPanel.backgroundColor'.
font := styleSheet fontAt:#'menu.font'.
fgColor := styleSheet colorAt:#'menuPanel.foregroundColor'.
self updateLevelAndBorder.
!
initialize
"set default configuration
"
super initialize.
self enableMotionEvents.
enabled := true.
self extentChangedFlag:false.
self originChangedFlag:false.
explicitExtent := nil.
shortKeyInset := 0.
mustRearrange := false.
!
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.
"
|loIndices loItems|
enteredItem := nil.
self enableMotionEvents.
self becomesActiveMenu.
super map.
loIndices := InitialSelectionQuerySignal query.
loItems := items ? #[].
loItems do:[:anItem| anItem fetchImages ].
self isPopUpView ifTrue:[
self doGrab
] ifFalse:[
super viewBackground:(self backgroundColor).
].
loItems do:[:el| el updateIndicators ].
loIndices size > 0 ifTrue:[
self redrawX:0 y:0 width:width height:height.
self openMenusFromItemIndices:loIndices.
].
"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.
"/ self mustRearrange.
shadowView notNil ifTrue:[
shadowView realize.
].
self raise.
self map.
] ifFalse:[
super realize.
].
self allSubViewsDo:[:aView| aView realize ].
!
recreate
"this is called after a snapin or a migration.
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.
self mustRearrange. "/ care for changed font sizes etc.
self do:[:anItem |
anItem reinitStyle
].
"Created: / 10.9.1998 / 21:37:05 / cg"
"Modified: / 17.8.2000 / 18:01:33 / cg"
!
reinitialize
"reinit after a snapIn
"
super reinitialize.
"/ self reinitStyle.
"Modified: / 17.8.2000 / 17:53:31 / 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].
!
updateLevelAndBorder
"update level & border, when it is known if I am a popUpView"
|bw lvl|
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 := styleSheet at:#'menuPanel.level'.
].
self borderWidth:bw.
self level:lvl.
! !
!MenuPanel methodsFor:'keyboard control'!
mnemonicViewNext:aKeyEvent
"a mnemonicKey event as forwarded from the keyboardProcessor - if there
is the mnemonic-key defined for any menuItem, handle the menuItem and
return the topMenu otherwise nil.
"
|menu uKey lKey list index|
superMenu notNil ifTrue:[ ^ superMenu mnemonicViewNext:aKeyEvent ].
shown ifFalse:[^ nil].
uKey := aKeyEvent rawKey last asUppercase.
lKey := uKey asLowercase.
selection notNil ifTrue:[
"first lookup the current grapMenu before starting in the topMenu
"
menu := self detectGrabMenu.
[ menu ~~ self ] whileTrue:[
index := menu selectionIndex.
list := menu selectItemIndicesFor:[:el||k| k := el accessCharacter. k == uKey or:[k == lKey]]
maxDepth:10 from:(index + 1) to:99999.
list size ~~ 0 ifTrue:[
"/ has item which responds to the mnemonic
menu processCollectedIndices:list.
^ self
].
menu := menu superMenu.
].
index := self selectionIndex.
list := self selectItemIndicesFor:[:el||k| k := el accessCharacter. k == uKey or:[k == lKey] ]
maxDepth:10 from:(1 + index) to:99999.
] ifFalse:[
index := 99999.
list := nil.
].
list ifNil:[
list := self selectItemIndicesFor:[:el||k| k := el accessCharacter. k == uKey or:[k == lKey] ]
maxDepth:10 from:1 to:index.
list isNil ifTrue:[
"/ must clear existing selection
self selection:nil.
^ nil
]
].
"/ has item which responds to the mnemonic
self processCollectedIndices:list.
^ self
!
openMenusFromItemIndices:anItemIndiceList
"open all menus derived from sequence of item indices
"
|item|
anItemIndiceList size == 0 ifTrue:[
^ self
].
item := self itemAt:(anItemIndiceList removeFirst).
(item notNil and:[item enabled]) ifTrue:[
InitialSelectionQuerySignal answer:anItemIndiceList do:[
self selection:item openMenu:true.
]
].
!
processCollectedIndices:indices
|menu item|
indices size == 0 ifTrue:[
^ self
].
menu := self.
[menu selectionIndex == indices first] whileTrue:[
( (item := menu selection) isNil "/ shouldn't happen
or:[(menu := item submenu) isNil] "/ no more indices; done
) ifTrue:[
^ true
].
indices removeFirst.
indices isEmpty ifTrue:[
menu selection:nil.
^ self
]
].
menu openMenusFromItemIndices:indices.
!
processShortcut:aKeyEvent
"a shortcutKey event as forwarded from the keyboardProcessor - if there is the
shortcut-key defined process the shortcut and return true otherwise false.
"
|menu rKey lKey list item|
superMenu notNil ifTrue:[
^ superMenu processShortcut:aKeyEvent
].
shown ifFalse:[^ false].
item := nil.
rKey := aKeyEvent rawKey.
lKey := aKeyEvent key.
menu := self detectGrabMenu. "/ first lookup the current grapMenu before starting in the topMenu
[true] whileTrue:[
list := menu selectItemIndicesFor:[:el||skey|
item := el.
skey := el shortcutKey.
skey == rKey or:[skey == lKey]
]
maxDepth:10.
list size ~~ 0 ifTrue:[
"/ has item which responds to the shortcut
item hasSubmenu ifFalse:[
menu accept:item
] ifTrue:[
menu processCollectedIndices:list.
self windowGroup focusView:self.
].
^ true
].
menu == self ifTrue:[ ^ false ].
menu := self.
].
^ false "/ never reached
!
selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth
"returns the sequence of indices up to the item for which the block
returns true. The first entry is the topmenu, the last entry the
item for which the block returns true.
If no item is detected, nil is returned
"
^ self selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth from:1 to:99999
!
selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth from:aStart to:aStop
"returns the sequence of indices up to the item for which the block
returns true. The first entry is the topmenu, the last entry the
item for which the block returns true.
If no item is detected, nil is returned
"
|start stop|
maxDepth <= 0 ifTrue:[^ nil].
start := aStart max:1.
stop := aStop min:(items size).
start to:stop do:[:i| |item menu seq isItem test|
item := items at:i.
test := isItem := aOneArgBlock value:item.
test ifFalse:[
item hasSubmenu ifTrue:[
test := item hasDelayedMenu not
]
].
test ifTrue:[
(item enabled and:[item isVisible]) ifTrue:[
isItem ifTrue:[ ^ OrderedCollection with:i ].
"process submenu"
menu := item submenu.
(menu notNil and:[menu isEnabled]) ifTrue:[
seq := menu selectItemIndicesFor:aOneArgBlock maxDepth:(maxDepth - 1).
seq notNil ifTrue:[
seq addFirst:i.
^ seq
]
]
]
].
].
^ nil
! !
!MenuPanel methodsFor:'misc'!
raiseDeiconified
^ self raise
"Created: 21.6.1997 / 13:29:12 / cg"
!
superMenu
"returns supermenu or nil
"
^ superMenu
!
topMenu
"returns the topMenu; the one having no superMenu
"
|menu smenu|
menu := self.
[(smenu := menu superMenu) notNil] whileTrue:[
menu := smenu
].
^ menu
! !
!MenuPanel methodsFor:'printing & storing'!
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 w views|
superMenu notNil ifTrue:[
^ superMenu application
].
appl := self menuAdornmentAt:#appl.
appl isNil ifTrue:[
(appl := super application) isNil ifTrue:[
windowGroup isNil ifTrue:[
^ nil "/ RETRY LATER
].
true ifTrue:[
^nil
] ifFalse:[
views := windowGroup mainGroup topViews.
views size == 0 ifTrue:[
^ nil "/ RETRY LATER
].
w := views first.
w == self ifTrue:[
thisContext isRecursive ifTrue:[
self error:'recursive application query'
].
"/ appl := #appl
].
appl := (w application) ? #appl.
].
].
self menuAdornmentAt:#appl put:appl
].
^ appl ~~ #appl 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 ]
]
!
registerImageOnDevice:anImage
|image|
(image := anImage) notNil ifTrue:[
image device ~~ device ifTrue:[
image := image copy.
].
image := image onDevice:device.
image := image clearMaskedPixels.
].
^ image
! !
!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-scrolling'!
hasScrollerAt:aDirection
"returns true if a visible scroller at a direction exists
"
|layout|
self hasScrollers ifFalse:[
^ false
].
aDirection == #PREV ifTrue:[
layout := items first layout.
^ self verticalLayout ifTrue:[ layout top < margin]
ifFalse:[ layout left < margin]
].
layout := items last layout.
^ self verticalLayout ifTrue:[ layout bottom > (height - margin)]
ifFalse:[ layout right > (width - margin)]
!
hasScrollers
"returns true if scrollers are needed
"
|maxExtent first last isVert|
(mustRearrange or:[items size < 2]) ifTrue:[^ false].
isVert := self verticalLayout.
superView notNil ifTrue:[
( (first := items first layout) isNil
or:[(last := items last layout) isNil]
) ifTrue:[
^ false
].
isVert ifTrue:[
^ first top < 0 or:[last bottom > height]
].
^ first left < 0 or:[last right > width]
].
maxExtent := self maxExtent.
isVert ifTrue:[
^ (height < maxExtent y) not
].
^ (width < maxExtent x) not
!
indexOfItemAtScroller:aDirection
"returns the index of the item under the scroller or 0
"
|bounds min max layout|
bounds := self scrollerBoundsAt:aDirection.
bounds isNil ifTrue:[
^ 0
].
self verticalLayout ifTrue:[
min := bounds top.
max := bounds bottom.
items keysAndValuesDo:[:anIndex :anItem|
anItem isVisible ifTrue:[
layout := anItem layout.
(layout top < max and:[layout bottom > min]) ifTrue:[
^ anIndex
].
].
].
] ifFalse:[
min := bounds left.
max := bounds right.
items keysAndValuesDo:[:anIndex :anItem|
anItem isVisible ifTrue:[
layout := anItem layout.
(layout left < max and:[layout right > min]) ifTrue:[
^ anIndex
].
].
]
].
^ 0
!
makeItemVisible:anItem
"make an item visible
"
|boundsPREV boundsNEXT delta layout index scr0 scr1 windowSz scrSz doScroll
isVertical boundsMin layoutMin boundsMax layoutMax dltOrg
inv1 inv2|
( anItem notNil
and:[self hasScrollers
and:[(layout := anItem layout) notNil]]
) ifFalse:[
^ self
].
index := self indexOfItem:anItem.
boundsPREV := self scrollerBoundsAt:#PREV.
boundsNEXT := self scrollerBoundsAt:#NEXT.
isVertical := self verticalLayout.
isVertical ifTrue:[
boundsMin := boundsPREV bottom.
boundsMax := boundsNEXT top.
layoutMin := layout top.
layoutMax := layout bottom.
windowSz := height.
] ifFalse:[
boundsMin := boundsPREV right.
boundsMax := boundsNEXT left.
layoutMin := layout left.
layoutMax := layout right.
windowSz := width.
].
layoutMin < boundsMin ifTrue:[
layoutMin >= 0 ifTrue:[
^ self
].
"/ test whether is first visible item
index := items findLast:[:el| el isVisible] startingAt:(index - 1).
index == 0 ifTrue:[ scr0 := margin ]
ifFalse:[ scr0 := boundsMin ].
delta := layoutMin negated + scr0.
] ifFalse:[
layoutMax > boundsMax ifFalse:[
^ self
].
"/ test whether is last visible item
index := items findFirst:[:el| el isVisible ] startingAt:(index + 1).
index == 0 ifTrue:[ scr0 := windowSz - margin ]
ifFalse:[ scr0 := boundsMax ].
delta := scr0 - layoutMax.
].
delta == 0 ifTrue:[ ^ self ].
doScroll := false.
shown ifTrue:[
delta abs < (windowSz / 2) ifTrue:[
doScroll := true.
self repairDamage
]
].
isVertical ifTrue:[ dltOrg := 0@delta ] ifFalse:[dltOrg := delta@0].
items do:[:el| el moveBy:dltOrg ].
doScroll ifFalse:[
^ self invalidate
].
windowSz := windowSz - margin - margin.
scr0 := boundsMin.
scr1 := scr0 + delta abs.
scrSz := boundsMax - scr1.
delta < 0 ifTrue:[
isVertical ifTrue:[
self copyFrom:self x:margin y:scr1 toX:margin y:scr0
width:windowSz height:scrSz async:false.
scr1 := scr0 + scrSz.
inv2 := (margin @ scr1) extent:(windowSz @ (height - scr1 - margin)).
"/ self invalidateX:margin y:scr1 width:windowSz height:(height - scr1 - margin).
] ifFalse:[
self copyFrom:self x:scr1 y:margin toX:scr0 y:margin
width:scrSz height:windowSz async:false.
scr1 := scr0 + scrSz.
inv2 := (scr1 @ margin) extent:((width - scr1 - margin) @ windowSz).
"/ self invalidateX:scr1 y:margin width:(width - scr1 - margin) height:windowSz.
].
inv1 := boundsPREV.
] ifFalse:[
isVertical ifTrue:[
self copyFrom:self x:margin y:scr0 toX:margin y:scr1
width:windowSz height:scrSz async:false.
inv2 := (margin @ margin) extent:(windowSz @ (scr1 - margin)).
"/ self invalidateX:margin y:margin width:windowSz height:scr1 - margin.
] ifFalse:[
self copyFrom:self x:scr0 y:margin toX:scr1 y:margin
width:scrSz height:windowSz async:false.
inv2 := (margin @ margin) extent:(scr1 - margin) @ windowSz.
"/ self invalidateX:margin y:margin width:scr1 - margin height:windowSz.
].
inv1 := boundsNEXT.
].
self invalidate:inv1.
self invalidate:inv2.
"Modified: / 13.11.2001 / 20:26:42 / cg"
!
scrollActivity
"returns the one and only scrollActivity - data holder
for a menu and all contained submenus
"
superMenu notNil ifTrue:[
^ superMenu scrollActivity
].
scrollActivity isNil ifTrue:[
scrollActivity := ScrollActivity new.
].
^ scrollActivity
!
scrollerBoundsAt:aDirection
"returns the bounds of the scroller at a direction or nil
"
|y x w h inset|
self hasScrollers ifFalse:[
^ nil
].
inset := 0.
x := y := inset.
w := h := 15.
self verticalLayout ifTrue:[
aDirection == #NEXT ifTrue:[
y := height - h - inset.
].
w := width - inset - inset.
] ifFalse:[
aDirection == #NEXT ifTrue:[
x := width - w - inset.
].
h := height - inset - inset.
].
^ Rectangle left:x top:y width:w height:h
!
scrollerDirectionAtPoint:aPoint
"returns the scroller-direction at aPoint, or nil
"
self hasScrollers ifTrue:[
#( PREV NEXT ) do:[:aDirection| |bounds|
( (bounds := self scrollerBoundsAt:aDirection) notNil
and:[bounds containsPoint:aPoint]
) ifTrue:[
^ (self hasScrollerAt:aDirection) ifTrue:[aDirection] ifFalse:[nil]
]
]
].
^ nil
"Created: / 13.11.2001 / 14:13:16 / 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 visibleSubmenu) 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 visibleSubmenu) isNil]) ifTrue:[
^ firstMenu
].
dstMenu := dstMenu detectMenuAtGrabPoint:aGrabPoint.
^ dstMenu ? firstMenu
!
detectViewAtX:x y:y in:aTopView
"detect view at x@y
"
^ aTopView detectViewAt:(x@y).
"/ cg: old code was (refactored to use common code)
"/
"/ |p subViews|
"/
"/ (subViews := aTopView subViews) notNil ifTrue:[
"/ subViews do:[:v| |p|
"/ v shown ifTrue:[
"/ ( (x between:(v left) and:(v right))
"/ and:[y between:(v top) and:(v bottom)]
"/ ) ifTrue:[
"/ p := device translatePoint:(x@y) from:(aTopView id) to:(v id).
"/ ^ self detectViewAtX:p x y:p y in:v.
"/ ]
"/ ]
"/ ]
"/ ].
"/ ^ aTopView
"Modified: / 10.10.2001 / 13:45:56 / cg"
!
itemAtPoint:aPoint
"returns the item at a point x@y or nil if none detected
"
items notNil ifTrue:[
^ items detect:[:el| el containsPoint:aPoint] ifNone:nil
].
^ nil
"Created: / 13.11.2001 / 13:58:23 / cg"
!
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
!
superMenuAtPoint:aPoint
"returns the superMenu which contains aPoint, or nil if none detected
"
|grabPoint superMenu|
(self containsPoint:aPoint) ifTrue:[
^ self
].
grabPoint := aPoint - (self translateGrabPoint:0).
superMenu := self.
[ (superMenu := superMenu superMenu) notNil ] whileTrue:[
(superMenu containsPoint:(superMenu translateGrabPoint:grabPoint)) ifTrue:[
^ superMenu
]
].
^ nil
"Created: / 13.11.2001 / 20:22:53 / cg"
! !
!MenuPanel methodsFor:'queries'!
container:aView
super container:aView.
aView notNil ifTrue:[
"/ I am no longer a popUpView
self updateLevelAndBorder
].
!
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
!
isViewWrapper
^ items size == 0 and:[subViews size ~~ 0]
!
type
^ nil.
! !
!MenuPanel methodsFor:'selection'!
hasSelection
"returns true if a selection exists
"
^ self selection notNil
!
openDelayed:anItem
|block|
superMenu ifNotNil:[
superMenu openDelayed:anItem.
^ self
].
adornment isNil ifTrue:[
anItem ifNil:[^ self].
adornment := DefaultAdornment copy.
] ifFalse:[
block := adornment removeKey:#delayedBlock ifAbsent:nil.
block ifNotNil:[ Processor removeTimedBlock:block ].
anItem ifNil:[^ self].
].
block := [ adornment at:#delayedBlock put:nil.
anItem openDelayedSubmenu
].
adornment at:#delayedBlock put:block.
Processor addTimedBlock:block afterSeconds:0.5.
!
selection
"returns current selected item or nil
"
^ selection
!
selection:anItemOrNil
"change selection to an item or nil
if the item has a submenu the first item might be selected (style-sheet)
"
|openMenu openOnSelect submenu item|
selection == anItemOrNil ifTrue:[^ self].
(anItemOrNil isNil or:[anItemOrNil hasSubmenu not]) ifTrue:[
self selection:anItemOrNil openMenu:false.
^ self
].
openMenu := self isPopUpView not.
openOnSelect := styleSheet at:#'menu.openOnSelect' default:false.
openMenu ifFalse:[
openMenu := openOnSelect.
].
self selection:anItemOrNil openMenu:openMenu.
openOnSelect ifFalse:[
"/ select first item in submenu
submenu := anItemOrNil currentSubmenu.
submenu ifNotNil:[
item := submenu itemAt:1.
((item := submenu itemAt:1) notNil and:[item hasSubmenu not]) ifTrue:[
submenu selection:item openMenu:false
]
].
].
!
selection:anItemOrNil openMenu:openMenu
"change selection to an item or nil
"
|item newSel hlp|
anItemOrNil == selection ifTrue:[
^ self
].
self openDelayed:nil.
newSel := nil.
anItemOrNil ifNotNil:[
self makeItemVisible:anItemOrNil.
anItemOrNil canSelect ifTrue:[
newSel := anItemOrNil
] ifFalse:[
selection ifNil:[^ self].
].
].
selection ifNotNil:[
"/ clear current selection
item := selection.
selection := nil.
item isSelected:false.
].
newSel ifNil:[^ self].
newSel == enteredItem ifTrue:[
enteredItem := nil
] ifFalse:[
self pointerEntersItem:nil
].
selection := newSel.
ActiveHelp isActive ifTrue:[
hlp := ActiveHelp currentHelpListener.
hlp initiateHelpFor:self at:nil now:true.
].
shown ifTrue:[
self rearrangeItems.
openMenu ifFalse:[
selection invalidate.
]
].
openMenu ifTrue:[
selection isSelected: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 methodsFor:'translation'!
translateGrabPoint:aGrabPoint
"translate the grab point into self
"
superMenu isNil ifTrue:[
"I am the grapView"
aGrabPoint isNumber ifTrue:[^ aGrabPoint @ aGrabPoint].
^ aGrabPoint
].
relativeGrabOrigin isNil ifTrue:[
relativeGrabOrigin := self topMenu translatePoint:0 to:self.
].
^ relativeGrabOrigin + aGrabPoint
!
translateMenuPoint:aPoint toMenu:aMenu
"translate a point into another menu its point
"
|grapPoint|
aMenu == self ifTrue:[
^ aPoint
].
grapPoint := aPoint - (self translateGrabPoint:0).
^ aMenu translateGrabPoint:grapPoint
!
translatePoint:aPoint to:anotherWindowOrNilForScreen
"translate a point in my window to anotherWindowOrNilForScreen (or root window if nil)
"
^ device
translatePoint:aPoint asPoint
fromView:self
toView:anotherWindowOrNilForScreen
"Modified: / 10.10.2001 / 14:11:47 / cg"
! !
!MenuPanel::Item class methodsFor:'accessing'!
horizontalInset
^ HorizontalInset
!
labelRightOffset
^ LabelRightOffset
!
verticalInset
^ VerticalInset
!
verticalPopUpInset
^ VerticalPopUpInset
! !
!MenuPanel::Item class methodsFor:'defaults'!
halfSeparatorSize
"returns size of a space-separator
"
^ 5
!
separatorSize
"returns size of a separator
"
^ 10
!
updateStyleCache
"setup defaults
self updateStyleCache
"
<resource: #style (#'menuPanel.verticalInset')>
HorizontalInset := 2.
VerticalInset := MenuPanel styleSheet at:#'menuPanel.verticalInset' default:2.
VerticalPopUpInset := 2.
HorizontalButtonInset := 3.
VerticalButtonInset := 3.
LabelRightOffset := 15.
! !
!MenuPanel::Item class methodsFor:'defaults delayed menu'!
delayedMenuIndicator
"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 delayedMenuIndicator inspect
ImageEditor openOnClass:self andSelector:#delayedMenuIndicator
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel::Item class delayedMenuIndicator'
ifAbsentPut:[(Depth1Image new) width: 7; height: 4; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@B@0 @a') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 7; height: 4; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'?''08D@@a') ; yourself); yourself]
!
delayedMenuIndicatorOffset
"returns an additional offset between the label and the
delayedMenu indication (i.e. the down-arrow icon)
"
^ 1 "2"
! !
!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:'accepting'!
canAccept
"returns true if item is acceptable
"
self enabled ifFalse:[ ^ false].
self hasSubmenu ifFalse:[ ^ true ].
self hasDelayedMenu ifFalse:[^ false ].
^ subMenu isNil or:[subMenu shown 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.
!
font
"returns the user configured font or nil (default menu font)
"
^ font
!
font:aFont
"returns the user configured font or nil (default menu font)
"
aFont ~= font ifTrue:[
font := aFont notNil ifTrue:[aFont onDevice:(menuPanel device)]
ifFalse:[nil].
rawLabel notNil ifTrue:[
"have to recompute the extent"
self label:label
]
].
!
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 mfont f oldExtent
h "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
|
oldExtent := rawLabelExtent.
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.
]
].
mfont := menuPanel setFont:font.
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.
].
"/ care for italic fonts - give a few more pixels at the end
f := mfont ? (menuPanel font).
(f notNil and:[f italic]) ifTrue:[
w := w + 2.
].
rawLabelExtent := w@h.
menuPanel setFont:mfont.
menuPanel shown ifTrue:[ self fetchImages ].
oldExtent = rawLabelExtent ifTrue:[
self invalidate
] ifFalse:[
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
"
|widget|
aSubMenu isNil ifTrue:[
subMenu notNil ifTrue:[
subMenu destroy.
subMenu := nil.
].
^ self
].
(aSubMenu isKindOf:Menu) ifTrue:[
subMenu := MenuPanel new.
menuPanel notNil ifTrue:[
subMenu receiver:menuPanel receiver.
].
subMenu superMenu:menuPanel.
horizontalLayout == true ifTrue:[
subMenu verticalLayout:false
].
subMenu menu:aSubMenu.
] ifFalse:[
aSubMenu isView ifFalse:[
(aSubMenu isKindOf:ApplicationModel) ifFalse:[
"/ ... mhhhh ....
^ self submenuChannel:aSubMenu
].
widget := SimpleView new.
widget client:aSubMenu.
] ifTrue:[
widget := aSubMenu
].
(widget isKindOf:MenuPanel) ifTrue:[
subMenu := widget.
horizontalLayout == true ifTrue:[ subMenu verticalLayout:false ].
] ifFalse:[
subMenu := MenuPanel new.
subMenu receiver:menuPanel receiver.
subMenu addSubView:widget.
subMenu extent:(widget preferredExtent).
widget origin:0.0@0.0 corner:1.0@1.0.
].
subMenu superMenu:menuPanel.
].
self keepLinkedMenu ifTrue:[
submenuChannel := nil
]
!
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
!
triggerOnDown
"trigger the action if pressed
"
triggerOnDown == true ifTrue:[
self hasSubmenu ifFalse:[^ true].
triggerOnDown := false.
].
^ false
!
triggerOnDown:aBool
"trigger the action if pressed
"
triggerOnDown := aBool.
!
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
]
].
!
delayMenu
"return true, the menu is shown delayed, if the button is still pressed after a while.
Only useful with buttons in non-popup-menus
"
^ delayMenu ? false
!
delayMenu:aBoolean
"if true, the menu is shown delayed, if the button is still pressed after a while.
Only useful with buttons in non-popup-menus
"
delayMenu := aBoolean.
!
enabled
"returns the enabled state
"
|state|
menuPanel enabled ifTrue:[
enableChannel isSymbol ifTrue:[
state := self aspectAt:enableChannel.
state isNil ifTrue:[
self ifNotInUIBuilderInfoPrintCR:
('MenuPanel::Item [info]: no aspect for ', enableChannel, ' (in ' , (label?rawLabel) printString , ')')
] ifFalse:[
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.
!
ifNotInUIBuilderInfoPrintCR:aMessage
"/ q&d hack to suppress info-messages in UIBuilder
(menuPanel receiver isNil
and:[ menuPanel application notNil
and:[ menuPanel application askFor:#isUIPainter]])
ifTrue:[
^ self "/ suppressed
].
aMessage infoPrintCR
!
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
]
].
!
keepLinkedMenu
"get the keepLinkedMenu flag
"
^ keepLinkedMenu ? false
!
keepLinkedMenu:aFlag
"get the keepLinkedMenu flag
"
keepLinkedMenu := aFlag
!
submenuChannel
"get the submenu channel
"
^ submenuChannel
!
submenuChannel:aSelectorOrNil
"returns the submenu channel
"
submenuChannel := aSelectorOrNil.
! !
!MenuPanel::Item methodsFor:'accessing-dimension'!
moveBy:aPoint
"move layout origin
"
layout moveBy:aPoint.
!
preferredExtent
"compute my preferred extent excluding the shortCutKey and the menu identifier
"
|isVertical icon
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 := (menuPanel isPopUpView ifTrue:[VerticalPopUpInset] ifFalse:[VerticalInset]) ? 2.
].
x := x * 2.
y := y * 2.
isVertical := menuPanel verticalLayout.
rawLabel isNil ifTrue:[
"SEPARATOR"
s := self class separatorSize.
label = '' ifTrue:[
s := self class halfSeparatorSize.
].
"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.
].
].
self hasDelayedMenuIndicator ifTrue:[
icon := self class delayedMenuIndicator.
x := x + self class delayedMenuIndicatorOffset + icon 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:'accessing-look'!
horizontalLayout
"on default submenus has a vertical layout;
true, the submenu has a horizontal layout.
"
subMenu ifNotNil:[
^ subMenu verticalLayout == false
].
^ horizontalLayout ? false
!
horizontalLayout:aBoolean
"on default submenus has a vertical layout;
true, the submenu has a horizontal layout.
"
aBoolean == true ifTrue:[
horizontalLayout := true
] ifFalse:[
horizontalLayout := nil "/ default
].
!
isButton
"returns whether item looks like a Button
"
^ isButton
!
isButton:anBoolean
"sets whether item looks like a Button
"
isButton := anBoolean.
layout notNil ifTrue:[
self invalidate.
]
!
layout
"returns my layout ( Rectangle )
"
^ layout
!
layout:aLayout
"set a new layout ( Rectangle )
"
layout := aLayout.
self invalidate.
!
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.
! !
!MenuPanel::Item methodsFor:'activation / deactivation'!
currentSubmenu
"returns the current submenu or nil
"
^ subMenu
!
hideSubmenu
"hide submenu
"
self hideSubmenu:subMenu.
!
hideSubmenu:aSubmenu
"hide submenu
"
|id|
aSubmenu ifNil:[^ self].
aSubmenu realized ifFalse:[
id := aSubmenu id.
id ifNotNil:[ menuPanel device unmapWindow:id ]
] ifTrue:[
aSubmenu hide
].
aSubmenu windowGroup:nil.
menuPanel windowGroup removeView:aSubmenu.
"/ release menu if derived from channel
submenuChannel notNil ifTrue:[
subMenu == aSubmenu ifTrue:[
subMenu := nil
]
].
!
openDelayedSubmenu
"called to open now my delayed submenu
"
|subm|
(self isSelected and:[menuPanel shown]) ifFalse:[^ self].
subMenu ifNotNil:[
subMenu realized ifTrue:[
"/ already open
^ self
].
].
subm := self setupSubmenu.
subm ifNil:[^ self].
self openSubmenu.
(subm == subMenu and:[self isSelected]) ifFalse:[
"/ closed during building or opening the submenu
self hideSubmenu:subm.
].
!
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 }"
|
(subMenu notNil and:[subMenu shown not and:[self isSelected and:[menuPanel realized]]]) ifFalse:[
^ self
].
topMenu := menuPanel topMenu.
(subMenu device notNil and:[topMenu device ~~ subMenu device]) ifTrue:[
subMenu releaseDeviceResources.
subMenu setDevice:topMenu device id:nil gcId:nil.
subMenu recreate.
].
windGrp := topMenu windowGroup.
subMenu superMenu:menuPanel.
subMenu becomesActiveMenu.
subMenu cursor:Cursor hand.
windGrp notNil ifTrue:[
subMenu windowGroup:windGrp.
windGrp addTopView:subMenu.
].
"Q&D kludge - test whether the layout is nil;
if true recompute the layouts
"
layout ifNil:[menuPanel rearrangeItems].
" 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 := menuPanel translatePoint:p to:nil. "/ translate to root window
].
left := o x.
top := o y.
top + height > devBot ifTrue:[
top := isVertical ifTrue:[devBot - height]
ifFalse:[top - layout height - height + 2]
].
top := top max:0.
"/ (isVertical not and:[subMenu isVerticalLayout]) ifTrue:[
"/ top < menuPanel bottom ifTrue:[
"/ left := left + layout width.
"/ ].
"/ left + width > devRight ifTrue:[
"/ left := o x - width - 2
"/ ].
"/ ].
left + width > devRight ifTrue:[
left := isVertical ifTrue:[left - layout width - width + 2]
ifFalse:[devRight - width]
].
left := left max:0.
subMenu origin:(left@top).
subMenu realized ifFalse:[
subMenu realize.
] ifTrue:[
topMenu device mapWindow:(subMenu id).
].
!
toggleSubmenuVisibility
"toggle the visibility of the submenu
"
subMenu notNil ifTrue:[
subMenu shown ifTrue:[^ self hideSubmenu]
] ifFalse:[
(subMenu := self setupSubmenu) isNil ifTrue:[
"/ cannot open a submenu
^ self
]
].
self openSubmenu.
!
visibleSubmenu
"returns the current visible submenu or nil
"
subMenu notNil ifTrue:[
subMenu shown ifTrue:[^ subMenu].
].
^ nil
! !
!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 isNil ifTrue:[
appl := menuPanel application.
].
appl isNil ifTrue:[ ^ nil].
MessageNotUnderstood handle:[:ex|
ex selector == aKey ifFalse:[
ex reject
].
self ifNotInUIBuilderInfoPrintCR:
('MenuPanel::Item [info]: application does not provide aspect: ' , aKey).
] do:[
aKey numArgs == 1 ifTrue:[
value := appl perform:aKey with:(argument ? self).
] ifFalse:[
(appl respondsTo:#aspectFor:) 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:[
(enableChannel value == false and:[self isSelected]) ifTrue:[
^ menuPanel selection:nil.
].
^ 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 isSymbol ifTrue:[
item enabled:enableChannel
].
item font:font.
item accessCharacterPosition:accessCharacterPosition.
item startGroup:startGroup.
item argument:argument.
item nameKey:nameKey.
item shortcutKeyCharacter:shortcutKey.
value isSymbol ifTrue:[item value:value].
indication isSymbol ifTrue:[item indication:indication].
choice isSymbol ifTrue:[item choice:choice].
isVisible isSymbol ifTrue:[item isVisible:isVisible].
item choiceValue:choiceValue.
item hideMenuOnActivated:hideMenuOnActivated.
item keepLinkedMenu:keepLinkedMenu.
item showBusyCursorWhilePerforming:showBusyCursorWhilePerforming.
item triggerOnDown:(self triggerOnDown).
item isButton:isButton.
self hasSubmenu ifTrue:[
horizontalLayout == true ifTrue:[
item horizontalLayout:true
].
submenuChannel isSymbol ifTrue:[
item submenuChannel:submenuChannel
] ifFalse:[
subMenu notNil ifTrue:[
item submenu:(subMenu asMenu)
]
].
].
^ item
!
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.
horizontalLayout := aMenuItem horizontalLayout.
triggerOnDown := aMenuItem triggerOnDown.
hideMenuOnActivated := aMenuItem hideMenuOnActivated.
keepLinkedMenu := aMenuItem keepLinkedMenu.
isButton := aMenuItem isButton ? false.
nameKey := aMenuItem nameKey.
startGroup := aMenuItem startGroup.
shortcutKey := aMenuItem shortcutKeyCharacter.
value := aMenuItem value.
activeHelpKey := aMenuItem activeHelpKey.
activeHelpText := nil.
self font:(aMenuItem font).
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 etchFg level isEnabled isSelected isPressedToggle bg ownBgCol
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
|
drawObject := rawLabel.
"COMPUTE COLORS"
isEnabled := self enabled.
isSelected := self isSelected.
isPressedToggle := self isToggle and:[self indicationValue].
(isSelected or:[isPressedToggle]) ifTrue:[
bg := self activeBackgroundColor.
fg := self activeForegroundColor.
] ifFalse:[
self isEntered ifTrue:[
bg := self buttonEnteredBackgroundColor
] ifFalse:[
bg := self backgroundColor
].
isEnabled ifTrue:[
fg := menuPanel foregroundColor
] ifFalse:[
fg := menuPanel disabledForegroundColor.
etchFg := menuPanel disabledEtchedForegroundColor.
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]).
]
].
y := 0.
isSelected ifTrue:[
level := menuPanel buttonActiveLevel.
x := x + 1 "level abs".
y := y + 1 "level abs".
] ifFalse:[
level := self isEntered ifTrue:[menuPanel buttonEnteredLevel]
ifFalse:[menuPanel buttonPassiveLevel].
].
etchFg notNil ifTrue:[
self drawRawLabel:drawObject atX:x+1 yOffset:y+1 paint:etchFg.
].
self drawRawLabel:drawObject atX:x yOffset:y+0 paint:fg.
self drawDelayedMenuIndicator.
level ~~ 0 ifTrue:[
menuPanel drawButtonEdgesFor:self level:level
].
!
drawDelayedMenuIndicator
"draw a labeled entry; no button, no separator.
"
|x y icon bAbsLevel|
self hasDelayedMenuIndicator ifFalse:[
^ self
].
icon := self class delayedMenuIndicator.
x := layout right - icon width.
false "/ delayedMenuIndicatorVerticalPosition == #center
ifTrue:[
y := layout height - icon height // 2 + layout top.
] ifFalse:[
y := layout bottom - icon height - 2.
].
bAbsLevel := 0.
isButton ifTrue:[
self isSelected ifTrue:[
x := x + 1.
y := y + 1.
].
bAbsLevel := menuPanel maxAbsoluteButtonLevel.
x := x - bAbsLevel.
y := y - bAbsLevel.
].
x := x - 1 "- HorizontalInset".
(self isEnabled "and:[self delayedMenuIsEnabled]") ifFalse:[
icon := menuPanel lightenedImageOnDevice:icon
].
icon displayOn:menuPanel x:x y:y.
(false "drawDelayedMenuIndicatorSeparator" and:[ menuPanel buttonPassiveLevel ~~ 0 ])
ifTrue:[
menuPanel paint:menuPanel buttonShadowColor.
menuPanel displayLineFromX:x-2 y:layout top+bAbsLevel+1 toX:x-2 y:layout bottom-bAbsLevel-2.
menuPanel paint:menuPanel buttonLightColor.
menuPanel displayLineFromX:x-1 y:layout top+bAbsLevel+1 toX:x-1 y:layout bottom-bAbsLevel-2.
].
!
drawLabel
"draw a labeled entry; no button, no separator.
"
|scKey cLb cLa drawObject fg etchFg arrow
isSelected isEnabled form
h "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
t "{ Class:SmallInteger }"
|
drawObject := rawLabel.
isEnabled := self enabled.
isSelected := self isSelected.
isSelected ifTrue:[
fg := self activeForegroundColor
] ifFalse:[
isEnabled ifTrue:[
self isEntered ifTrue:[
fg := menuPanel enteredForegroundColor
] ifFalse:[
fg := menuPanel foregroundColor
]
] ifFalse:[
fg := menuPanel disabledForegroundColor.
etchFg := menuPanel disabledEtchedForegroundColor.
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.
].
etchFg notNil ifTrue:[
self drawRawLabel:drawObject atX:x+1 yOffset:1 paint:etchFg.
].
self drawRawLabel:drawObject atX:x yOffset:0 paint:fg.
self drawDelayedMenuIndicator.
"/ 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 yOffset:yOffset paint:fg
"draw a labeled entry; no button, no separator.
"
|mfont fontAscent
y "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
|
mfont := menuPanel setFont:font.
fontAscent := menuPanel font ascent.
menuPanel paint:fg.
y := layout top + (layout height - rawLabelExtent y // 2) + yOffset.
aLabel isArray ifFalse:[
aLabel isImageOrForm ifFalse:[
y := y + fontAscent.
].
aLabel displayOn:menuPanel x:x y:y.
] ifTrue:[
aLabel do:[:el|
el notNil ifTrue:[
el isImageOrForm ifFalse:[
y0 := y + fontAscent
] 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:
]
].
].
menuPanel setFont:mfont
!
drawSeparatingLines
"draw separating lines
"
|myIndex lfSep rtSep items prevItem nextItem
lightColor shadowColor
l "{ Class:SmallInteger }"
t "{ Class:SmallInteger }"
r "{ Class:SmallInteger }"
b "{ Class:SmallInteger }"
|
items := menuPanel items.
myIndex := items identityIndexOf:self.
prevItem := items at:(myIndex - 1) ifAbsent:nil.
lfSep := prevItem notNil and:[prevItem isButton not].
nextItem := items at:(myIndex + 1) ifAbsent:nil.
rtSep := nextItem notNil and:[nextItem isButton not].
(lfSep or:[rtSep]) ifFalse:[
^ self
].
lightColor := menuPanel lightColor.
shadowColor := menuPanel shadowColor.
menuPanel paint: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: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: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 shadowColor isDouble
left top
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.
shadowColor := menuPanel shadowColor.
menuPanel paint:shadowColor.
left := layout left.
top := layout top.
menuPanel verticalLayout ifTrue:[
x0 := left + HorizontalInset.
x1 := layout right - HorizontalInset.
y0 := 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 := left - 1 + (layout width // 2).
y0 := 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:[
(self isEnabled and:[ self isEntered ]) ifTrue:[
menuPanel enteredBackgroundColor
] 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.
!
reinitStyle
subMenu notNil ifTrue:[
subMenu reinitStyle
].
"Created: / 17.8.2000 / 17:57:07 / cg"
"Modified: / 17.8.2000 / 18:00:08 / cg"
! !
!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
!
fetchDeviceResources
disabledRawLabel := nil.
self fetchImages.
font notNil ifTrue:[
font := font onDevice:(menuPanel device)
].
!
fetchImages
"fetch images
"
|icon|
(rawLabel isNil or:[rawLabel isString]) ifTrue:[
^ self
].
rawLabel isImageOrForm ifTrue:[
rawLabel := menuPanel imageOnDevice:rawLabel.
^ self.
].
rawLabel class == LabelAndIcon ifTrue:[
(icon := rawLabel image) notNil ifTrue:[
rawLabel image:(menuPanel imageOnDevice:icon)
].
(icon := rawLabel icon) notNil ifTrue:[
rawLabel icon:(menuPanel imageOnDevice:icon)
].
^ self
].
rawLabel isArray ifFalse:[^ self].
rawLabel keysAndValuesDo:[:i :el|
(el notNil and:[el isString not]) ifTrue:[
el isImageOrForm ifTrue:[
rawLabel at:i put:(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)
]
]
]
]
].
!
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:[
^ label
].
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
"
|isOn|
choice isNil ifTrue:[^ nil].
isOn := choice value = choiceValue.
self enabled ifFalse:[
^ isOn ifTrue:[menuPanel iconRadioGroupDisabledOn]
ifFalse:[menuPanel iconRadioGroupDisabledOff]
].
^ isOn 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 numArgs|
aRecv isNil ifTrue:[^ nil].
sel := submenuChannel asSymbol.
numArgs := sel numArgs.
numArgs == 0 ifTrue:[
MessageNotUnderstood handle:[:ex |
|selector|
((selector := ex message selector) == sel
or:[selector == #aspectFor:]) ifFalse:[
ex reject
].
] do:[
subm := aRecv aspectFor:sel.
].
subm notNil ifTrue:[^ subm].
].
(Array with:(aRecv) with:(aRecv class))
do:[:aPossibleReceiver |
MessageNotUnderstood handle:[:ex|
ex message selector == sel ifFalse:[ ex reject ]
] do:[
numArgs == 0 ifTrue:[
subm := aPossibleReceiver perform:sel
] ifFalse:[
numArgs == 1 ifTrue:[
subm := aPossibleReceiver perform:sel with:(argument ? menuPanel)
] ifFalse:[
subm := aPossibleReceiver perform:sel with:argument with:menuPanel
]
]
].
subm notNil ifTrue:[^ subm].
].
^ subm
"Modified: / 30.10.2001 / 13:28:25 / 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.
MessageNotUnderstood handle:[:ex|
ex message 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].
].
MessageNotUnderstood handle:[:ex|
(ex message selector ~~ indication) ifTrue:[
ex reject
].
self ifNotInUIBuilderInfoPrintCR:
('MenuPanel::Item [info]: application does not respond to ' , indication).
] do:[
numArgs == 1 ifTrue:[
recv perform:indication with:aValue
] ifFalse:[
recv perform:indication with:(argument ? self) with:aValue
]
].
!
indicatorForm
"returns indication form or nil
"
|val|
indication isNil ifTrue:[^ nil].
val := self indicationValue.
self enabled ifFalse:[
^ val == true
ifTrue:[menuPanel iconIndicationDisabledOn]
ifFalse:[menuPanel iconIndicationDisabledOff]
].
^ val == 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"
!
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 master recv submenuHolder submenu submenuEncoding|
submenuChannel notNil ifTrue:[
submenuChannel isSymbol ifFalse:[
submenuHolder := submenuChannel
] ifTrue:[
appl := menuPanel application.
appl isNil ifTrue:[
appl := menuPanel receiver.
appl notNil ifTrue:[
(submenuHolder := self findSubMenuIn:appl) isNil ifTrue:[
[submenuHolder isNil
and:[(master := appl perform:#masterApplication ifNotUnderstood:nil) notNil
and:[master ~~ appl]]] whileTrue:[
appl := master.
submenuHolder := self findSubMenuIn:appl.
].
]
].
].
submenuHolder isNil ifTrue:[
(submenuHolder := self findSubMenuIn:appl) isNil ifTrue:[
(recv := menuPanel receiver) ~~ appl ifTrue:[
appl := recv.
submenuHolder := self findSubMenuIn:appl
]
]
]
].
(submenu := submenuHolder value) isArray ifTrue:[
submenuEncoding := submenu.
submenu := Menu new fromLiteralArrayEncoding:submenuEncoding.
"/ cg: linked menus also may contain translations ...
submenu notNil ifTrue:[
appl notNil ifTrue:[
submenu findGuiResourcesIn:appl.
]
].
].
"/ appl notNil ifTrue:[submenu application:appl].
self submenu:submenu.
].
^ 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
!
containsPoint:aPoint
"returns true if aPoint is contained in my layout
"
(self isVisible and:[layout notNil]) ifTrue:[
^ layout containsPoint:aPoint
].
^ false
"Created: / 13.11.2001 / 13:55:31 / cg"
!
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
!
hasDelayedMenu
"returns true if a delayed menu exists
"
(subMenu isNil and:[submenuChannel isNil]) ifTrue:[
^ false
].
(value isNil and:[indication isNil and:[choice isNil]]) ifTrue:[
^ false
].
^ true
!
hasDelayedMenuIndicator
"returns true if the item has a delayed menu
and is the topMenu
"
menuPanel isPopUpView ifFalse:[
^ self hasDelayedMenu
].
^ 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
!
isToggle
"returns true if on/off indication exists
"
^ self hasIndication and:[ self isButton ]
!
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 notNil and:[menuPanel selection == self]
!
isSelected:isSelected
"change selection to a state. Dependant on the state open or hide an existing
submenu and perform a redraw
"
(isSelected and:[menuPanel notNil]) ifFalse:[
self invalidate.
self hideSubmenu.
^ self
].
menuPanel realized ifFalse:[ ^ self ].
(indication isNil or:[isButton not]) ifTrue:[
self invalidate
].
self hasSubmenu ifFalse:[ ^ self].
self hasDelayedMenu ifTrue:[
menuPanel openDelayed:self
] ifFalse:[
subMenu := self setupSubmenu.
subMenu ifNotNil:[ self openSubmenu ].
].
! !
!MenuPanel::ScrollActivity class methodsFor:'default icons'!
icon
"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 icon inspect
ImageEditor openOnClass:self andSelector:#icon
"
<resource: #image>
^Icon
constantNamed:#'MenuPanel::Scrolling class icon'
ifAbsentPut:[(Depth1Image new) width: 11; height: 11; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'?>@@@@@@ @C@@N@@<@C8@O<@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 11; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@_<@? A<@C @D@@@@@@@@@@@a') ; yourself); yourself]
! !
!MenuPanel::ScrollActivity class methodsFor:'instance creation'!
new
^ self basicNew initialize
! !
!MenuPanel::ScrollActivity methodsFor:'accessing'!
activeMenu
"returns the active menu the scrolling is activated on; nil
is returned if scrolling is deactivated
"
^ activeMenu
!
direction
"returns the scroll-direction
"
^ direction
!
iconAt:aDirection on:aMenu
|icon device index|
device := aMenu device.
aDirection == #PREV ifTrue:[
aMenu verticalLayout ifTrue:[index := 3] "/ 3 - 1 * 90 180
ifFalse:[index := 2] "/ 2 - 1 * 90 90
] ifFalse:[
aMenu verticalLayout ifTrue:[index := 1] "/ 1 - 1 * 90 0
ifFalse:[index := 4] "/ 4 - 1 * 90 270
].
icon := icons at:index.
(icon isNil or:[icon device ~~ device]) ifTrue:[
icon := self class icon.
index > 1 ifTrue:[ icon := icon rotated:(index - 1 * 90) ]
ifFalse:[ icon := icon copy ].
icon := icon onDevice:device.
icon clearMaskedPixels.
icons at:index put:icon
].
^ icon
! !
!MenuPanel::ScrollActivity methodsFor:'initialization'!
initialize
semaLock := RecursionLock new.
icons := Array new:4.
! !
!MenuPanel::ScrollActivity methodsFor:'queries'!
isActive
"returns true if scrolling is activated
"
^ activeMenu notNil
! !
!MenuPanel::ScrollActivity methodsFor:'user operations'!
startIfRequiredAt:aDirection on:aMenu
"start scrolling; returns true if scrolling is activated
"
|bounds index|
semaLock critical:[
self stop.
( aDirection notNil
and:[aMenu notNil
and:[(bounds := aMenu scrollerBoundsAt:aDirection) notNil]]
) ifTrue:[
activeMenu := aMenu.
direction := aDirection.
index := aMenu indexOfItemAtScroller:aDirection.
index ~~ 0 ifTrue:[
scrollTask :=
[
|item step|
[
step := (aDirection == #PREV) ifTrue:[-1] ifFalse:[1].
( aMenu shown and:[(item := aMenu itemAt:index) notNil] ) ifTrue:[
aMenu makeItemVisible:item.
index := index + step.
].
Delay waitForSeconds:(ButtonController defaultInitialDelay).
[ aMenu shown and:[(item := aMenu itemAt:index) notNil] ] whileTrue:[
aMenu makeItemVisible:item.
Delay waitForSeconds:(ButtonController defaultRepeatDelay).
index := index + step.
].
item := nil.
] ensure:[
scrollTask := nil.
item notNil ifTrue:[
"/ process was killed
aMenu invalidate:bounds
]
]
] forkAt:8.
]
]
].
^ bounds notNil
"Created: ca"
"Modified: / 13.11.2001 / 20:15:52 / cg"
!
stop
"stop scrolling; returns true if the scrolling was activated otherwise false
"
|task resp|
activeMenu isNil ifTrue:[
^ false
].
semaLock critical:[
resp := activeMenu notNil.
(task := scrollTask) notNil ifTrue:[
scrollTask := nil.
Error handle:[:ex|
] do:[
task terminateWithAllSubprocessesInGroup.
task waitUntilTerminated.
].
].
activeMenu := direction := nil.
].
^ resp
! !
!MenuPanel class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.334 2002-10-05 16:25:28 ca Exp $'
! !
MenuPanel initialize!