.
"
COPYRIGHT (c) 1989 by Claus Gittinger
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.
"
PopUpView subclass:#PopUpMenu
instanceVariableNames:'menuView lastSelection memorize hideOnLeave
actionLabels actionLines actionValues
hideOnRelease defaultHideOnRelease'
classVariableNames:'DefaultHideOnRelease'
poolDictionaries:''
category:'Views-Menus'
!
PopUpMenu comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.24 1995-08-08 01:22:17 claus Exp $
'!
!PopUpMenu class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
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.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.24 1995-08-08 01:22:17 claus Exp $
"
!
documentation
"
This class provides PopUpMenu functionality; Actually, this class
only provides the popup and shadow functionality and wraps another
view, which is the actual menu-list (usually an instance of MenuView).
PopUpMenus are usually created with a list of labels, selectors and a
receivier. Once activated, the specified receiver will be sent a
'selector'-message.
PopupMenus may be either assigned statically to a view (via the #middleButtonMenu:
message) or created dynamically as required.
Static definition makes sense, if the menu stays constant and you want to
assign it once for the lifetime of the view.
Dynamic menus are easier to use, if the number of or look of the entries has to
change according the internal state of some model. Also, this is the ST-80 way
of using popupMenus. For dynamic popups, the views model is asked for a menu
via the #menuSelector each time a button press occurs.
See examples section for more.
"
!
examples
"
Examples:
|p|
p := PopUpMenu
labels:#('foo'
'bar'
'baz')
selectors:#(
#foo
#bar
#baz)
receiver:nil.
p showAtPointer
sometimes, you want to specify both selectors and some arguments
to be sent; this is done by:
|p|
p := PopUpMenu
labels:#('foo' 'bar' 'baz')
selectors:#(#foo: #bar: #foo:)
args:#(1 2 3)
receiver:nil.
p showAtPointer
or, the same selector but different arguments:
|p|
p := PopUpMenu
labels:#('foo' 'bar' 'baz')
selectors:#foo:
args:#(1 2 3)
receiver:nil.
p showAtPointer
Normally, you do not show the menu explicitely, but install
it as a either as middleButtonMenu of some view or return it from
a model.
(Views/Controllers button-event handler will show it when the middle
button is pressed ...)
Static menu:
|v m|
v := View new.
m := PopUpMenu
labels:#('lower'
'raise'
'-'
'destroy')
selectors:#(#lower #raise nil #destroy)
receiver:v.
v middleButtonMenu:m.
v open
Dynamic menu:
(since we need some model which responds to a menu-message,
we use a plug in the example below; normally, this would be your model)
|v model|
model := Plug new.
model respondTo:#getMenu with:[PopUpMenu labels:#('foo' 'bar')
selectors:#(foo bar)].
model respondTo:#foo with:[Transcript showCr:'models foo called'].
model respondTo:#bar with:[Transcript showCr:'models bar called'].
v := View new.
v model:model; menu:#getMenu.
v open
Dynamic menus are the MVC-way (i.e. ST-80) way of doing things.
They are usually easier to use, if the menu changes depending on the models
state. (for example, see the systemBrowsers menus being different when
things are selected ...)
It is also possible, to add check-mark entries, with an entry string
starting with the special sequence '\c' (for check-mark). The value
passed will be the truth-state of the check-mark.
|m v|
v := View new.
m := PopUpMenu
labels:#('\c foo'
'\c bar')
selectors:#(#value: #value:)
receiver:[:v | Transcript show:'arg: '; showCr:v].
v middleButtonMenu:m.
v open
Finally, you can wrap other views into a popup menu (for example,
to implement menus with icons or other components).
The view should respond to some messages sent from here (for
example: #hideSubmenus, #deselectWithoutRedraw and others).
Currently there is only one class in the system, which can be used
this way (PatternMenu in the DrawTool demo):
|v p|
v := View new.
p := PatternMenu new.
p patterns:(Array with:Color red
with:Color green
with:Color blue).
v middleButtonMenu:(PopUpMenu forMenu:p).
v open
or try:
|v p|
v := View new.
p := PatternMenu new.
p patterns:(Array with:Color red
with:Color green
with:Color blue).
p selectors:#value:.
p receiver:[:val | v viewBackground:val. v clear].
p args:(Array with:Color red
with:Color green
with:Color blue).
v middleButtonMenu:(PopUpMenu forMenu:p).
v open
ST-80 style:
The above menus all did some message send on selection; it is
also possible, to use Smalltalk-80 style menus (which return some value
from their startup method):
|m selection|
m := PopUpMenu
labels:#('one' 'two' 'three').
selection := m startUp.
Transcript show:'the selection was: '; showCr:selection
startUp will return the entries index, or 0 if there was no selection.
You can also specify an array of values to be returned instead of the
index:
|m selection|
m := PopUpMenu
labels:#('one' 'two' 'three')
values:#(10 20 30).
selection := m startUp.
Transcript show:'the value was: '; showCr:selection
In ST/X style menus, separating lines between entries are created
by a '-'-string as its label text (and corresponding nil-entries in the
selectors- and args-arrays).
In ST-80, you have to pass the indices of the lines in an extra array:
|m selection|
m := PopUpMenu
labels:#('one' 'two' 'three' 'four' 'five')
lines:#(2 4).
selection := m startUp.
Transcript show:'the value was: '; showCr:selection
or:
|m selection|
m := PopUpMenu
labels:#('one' 'two' 'three')
lines:#(2)
values:#(10 20 30).
selection := m startUp.
Transcript show:'the value was: '; showCr:selection
Use whichever interface you prefer.
"
! !
!PopUpMenu class methodsFor:'defaults'!
updateStyleCache
DefaultHideOnRelease := StyleSheet at:#popupHideOnRelease default:true.
! !
!PopUpMenu class methodsFor:'instance creation'!
forMenu:aMenuView
"this wraps an already existing menu - allowing to put any
view (not just MenuViews) into popups (for example, menus
with icons, or other components).
Currently, there is only one example of different menus in
the system (PatternMenu in the DrawTool) which could be used
this way.
The view should respond to some of the menuView messages
(such as hideSubmenu, deselectWithoutRedraw etc.)"
|newMenu|
newMenu := self onSameDeviceAs:aMenuView.
newMenu addSubView:aMenuView.
newMenu menu:aMenuView.
^ newMenu
!
labels:labels selectors:selectors args:args receiver:anObject for:aView
"create and return a popup menu with labels as entries.
Each item will send a corresponding selector:argument from the selectors-
and args array to anObject. The menu is created on the same physical device
as aView (which is only of interrest in multi-Display applications;
typical applications can use the sibbling message without the for: argument)."
|newMenu|
newMenu := self onSameDeviceAs:aView.
newMenu menu:(MenuView
labels:labels
selectors:selectors
args:args
receiver:anObject
in:newMenu).
^ newMenu
!
labels:labels selectors:selectors receiver:anObject for:aView
"create and return a popup menu with labels as entries.
Each item will send a corresponding selector from the selectors-array
to anObject. The menu is created on the same physical device
as aView (which is only of interrest in multi-Display applications;
typical applications can use the sibbling message without the for: argument)."
^ self labels:labels selectors:selectors args:nil receiver:anObject for:aView
!
labels:labels selector:aSelector args:args receiver:anObject for:aView
"create and return a popup menu with labels as entries.
Each item will send aSelector with a corresponding argument from the
args array to anObject. The menu is created on the same physical device
as aView (which is only of interrest in multi-Display applications;
typical applications can use the sibbling message without the for: argument)."
"
OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
"
^ self labels:labels selectors:aSelector args:args receiver:anObject for:aView
!
labels:labels selectors:selectors args:args receiver:anObject
"create and return a popup menu with labels as entries.
Each item will send a corresponding selector:argument from the selectors-
and args array to anObject. The menu is created on the default Display"
^ self labels:labels selectors:selectors args:args receiver:anObject for:nil
!
labels:labels selector:aSelector args:args receiver:anObject
"create and return a popup menu with labels as entries.
Each item will send aSelector with a corresponding argument from the
args array to anObject. The menu is created on the default DIsplay"
"
OBSOLETE protocol: #labels:selectors:... knows how to handle single-symbol selectors-arg
"
^ self labels:labels selectors:aSelector args:args receiver:anObject
!
labels:labels selectors:selectors receiver:anObject
"create and return a popup menu with labels as entries.
Each item will send a message with a selector from the corresponding
selectors-array.
The menu is created on the default Display."
^ self labels:labels selectors:selectors args:nil receiver:anObject for:nil
!
labels:labels selectors:selectors
"create and return a menu with label-items and selectors. The receiver
will either be defined later, or not used at all (if opened via startUp)"
^ self labels:labels selectors:selectors args:nil receiver:nil for:nil
!
labels:labels selectors:selectors args:argArray
"create and return a menu with label-items and selectors. The receiver
will either be defined later, or not used at all (if opened via startUp)"
^ self labels:labels selectors:selectors args:argArray receiver:nil for:nil
! !
!PopUpMenu class methodsFor:'ST-80 instance creation'!
labels:labels
"ST80R2 compatibility"
^ self labels:labels lines:nil values:nil
!
labels:labels values:values
"ST80R2 compatibility"
^ self labels:labels lines:nil values:values
!
labels:labels lines:lines
"ST80R2 compatibility"
^ self labels:labels lines:lines values:nil
!
labels:labels lines:lines values:values
"ST80R2 compatibility"
^ (self new) labels:labels lines:lines values:values
!
labelArray:labels values:values
"ST80R4 compatibility"
^ self labels:labels lines:nil values:values
!
labelArray:labels lines:lines values:values
"ST80R4 compatibility"
^ self labels:labels lines:lines values:values
!
labelList:labels values:values
"ST80R4 compatibility:
given a list consisting of group label entries (to be separated by
lines), convert into standard form (using '-' for lines.
"
|newLabels newValues lS vS first|
newLabels := OrderedCollection new.
newValues := OrderedCollection new.
lS := ReadStream on:labels.
values notNil ifTrue:[vS := ReadStream on:values].
first := true.
[lS atEnd] whileFalse:[
|entry|
entry := lS next.
entry isCollection ifTrue:[
first ifFalse:[
newLabels add:'-'.
values notNil ifTrue:[newValues add:nil]
].
newLabels addAll:entry.
values notNil ifTrue:[newValues addAll:(vS next:entry size)]
] ifFalse:[
newLabels add:entry.
values notNil ifTrue:[newValues add:(vS next)]
].
first := false.
].
values isNil ifTrue:[
^ self labels:newLabels
].
^ self labels:newLabels values:newValues
"
(PopUpMenu labels:#('1' '2' '3') values:#(1 2 3)) showAtPointer
(PopUpMenu labelList:#(('1') ('2' '3')) values:#(1 2 3)) showAtPointer
(PopUpMenu labelList:#(('1') ('2') ('3')) values:#(1 2 3)) showAtPointer
"
!
labelList:labels
"ST80R4 compatibility:
given a list consisting of group label entries (to be separated by
lines), convert into standard form (using '-' for lines.
"
^ self labelList:labels values:nil
"
(PopUpMenu labels:#('1' '2' '3')) showAtPointer
(PopUpMenu labelList:#(('1') ('2' '3'))) showAtPointer
(PopUpMenu labelList:#(('1') ('2') ('3'))) showAtPointer
"
!
labelList:labels lines:lines values:values
"mhmh what is that ?"
^ (self new) labels:labels lines:lines values:values
! !
!PopUpMenu methodsFor:'initialization'!
initialize
super initialize.
memorize := true.
hideOnLeave := false.
defaultHideOnRelease := DefaultHideOnRelease.
!
initEvents
super initEvents.
self enableEnterLeaveEvents.
self enableMotionEvents.
! !
!PopUpMenu methodsFor:'realization'!
fixSize
"called right before the view is made visible.
adjust my size to the size of the actual menu"
|extra newWidth newHeight|
extra := margin * 2.
menuView resizeIfChanged.
newWidth := menuView width + extra.
newHeight := menuView height + extra.
((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
self extent:(menuView width + extra) @ (menuView height + extra)
].
super fixSize
!
realize
menuView deselectWithoutRedraw.
super realize.
hideOnRelease := defaultHideOnRelease.
! !
!PopUpMenu methodsFor:'private accessing'!
menu:aMenu
"set the actual menu"
menuView := aMenu.
menuView origin:(margin @ margin).
menuView borderWidth:0.
menuView masterView:self
!
menuView
"return the actual menu"
^ menuView
!
superMenu:aMenu
"return the superMenu"
menuView superMenu:aMenu
! !
!PopUpMenu methodsFor:'accessing-mvc'!
changeMessage:aSymbol
"forward to my menu"
menuView changeMessage:aSymbol
!
changeMessage
"forward from my menu"
^ menuView changeMessage
!
model
^ menuView model
!
model:aModel
menuView model:aModel
! !
!PopUpMenu methodsFor:'menuview messages'!
doesNotUnderstand:aMessage
"forward all menu-view messages"
(menuView respondsTo:(aMessage selector)) ifTrue:[
^ aMessage sendTo:menuView
].
^ super doesNotUnderstand:aMessage
! !
!PopUpMenu methodsFor:'accessing-behavior'!
hideOnLeave:aBoolean
"set/clear the hideOnLeave attribute, which controls
if the menu should be hidden when the pointer leaves
the view (used with multiple-menus)"
hideOnLeave := aBoolean
!
hideOnRelease:aBoolean
"set/clear the hideOnRelease attribute, which controls
if the menu should be hidden when the button is released"
hideOnRelease := aBoolean.
menuView hideOnRelease:aBoolean
! !
!PopUpMenu methodsFor:'accessing-look'!
viewBackground:aColor
"this is a kludge and will vanish ..."
super viewBackground:aColor.
menuView viewBackground:aColor
!
font:aFont
menuView font:aFont
! !
!PopUpMenu methodsFor:'accessing-items'!
labels
"return the list of labels"
actionLabels notNil ifTrue:[
^ actionLabels asStringCollection
].
^ menuView list
!
indexOf:indexOrName
"return the index of a submenu - or 0 if there is none"
^ menuView indexOf:indexOrName
!
remove:indexOrName
"remove a menu entry"
menuView remove:indexOrName
!
subMenuAt:indexOrName put:aMenu
"define a submenu to be shown for entry indexOrName"
"
aMenu hideOnLeave:true.
"
menuView subMenuAt:indexOrName put:aMenu.
"tell the submenu to notify me when action is performed"
aMenu superMenu:self.
"
|v m someObject|
v := View new.
m := PopUpMenu labels:#('1' '2' '3')
selectors:#(one two nil)
receiver:someObject
for:nil.
m subMenuAt:3 put:(PopUpMenu
labels:#('a' 'b' 'c')
selectors:#(a b c)
receiver:someObject
for:nil).
v middleButtonMenu:m.
v realize
"
!
numberOfItems
"return the number of items in the menu"
actionLabels notNil ifTrue:[
^ actionLabels asStringCollection size
].
^ menuView list size
!
values
"st-80 compatibility"
^ actionValues
!
values:aValueArray
"st-80 compatibility"
actionValues := aValueArray
!
lines
"st-80 compatibility"
^ actionLines
!
labels:labelString lines:lineArray values:valueArray
"define the menu the ST-80 way (with labels and lines defined separately)"
|labelArray argArray convertedLabels
offs dstOffs linePos|
actionLabels := labelString.
actionLines := lineArray.
actionValues := valueArray.
labelArray := labelString asStringCollection.
convertedLabels := Array new:(labelArray size + lineArray size).
argArray := Array new:(labelArray size + lineArray size).
offs := 1.
dstOffs := 1.
1 to:lineArray size do:[:lineIndex |
linePos := lineArray at:lineIndex.
[offs <= linePos] whileTrue:[
convertedLabels at:dstOffs put:(labelArray at:offs).
argArray at:dstOffs put:offs.
offs := offs + 1.
dstOffs := dstOffs + 1
].
convertedLabels at:dstOffs put:'-'.
argArray at:dstOffs put:nil.
dstOffs := dstOffs + 1
].
[offs <= labelArray size] whileTrue:[
convertedLabels at:dstOffs put:(labelArray at:offs).
argArray at:dstOffs put:offs.
offs := offs + 1.
dstOffs := dstOffs + 1
].
self menu:(MenuView
labels:convertedLabels
selectors:nil
args:argArray
receiver:nil
in:self)
! !
!PopUpMenu methodsFor:'deactivation'!
hide
"hide the menu - if there are any pop-up-submenus, hide them also"
menuView hideSubmenu.
windowGroup notNil ifTrue:[
windowGroup removeView:menuView.
].
super hide.
menuView superMenu notNil ifTrue:[
menuView superMenu regainControl
].
! !
!PopUpMenu methodsFor:'ST-80 activation'!
startUp
"start the menu modal - return the selected value,
or - if no values where specified - return the index.
If nothing was selected, return 0.
Modal - i.e. stay in the menu until finished.
This is the ST-80 way of launching a menu."
|return rec sel0 sel1 arg|
return := 0.
menuView action:[:selected |
|actionIndex value sel retVal|
retVal := 0.
menuView args isNil ifTrue:[
menuView selectors notNil ifTrue:[
"/ sel := menuView selectors at:selected.
"/ sel notNil ifTrue:[sel0 := sel].
"/ (arg := menuView checkFlags at:selected) isNil ifTrue:[
sel0 := menuView selectors at:selected.
"/ ] ifFalse:[
"/ sel1 := menuView selectors at:selected.
"/ ].
"/ retVal := nil.
]
] ifFalse:[
actionIndex := menuView args at:selected.
actionIndex notNil ifTrue:[
actionValues isNil ifTrue:[
menuView selectors notNil ifTrue:[
"/ mhmh an ST/X menu started the ST-80 way
sel1 := menuView selectors at:selected.
arg := actionIndex.
"/ retVal := nil.
] ifFalse:[
retVal := actionIndex
]
] ifFalse:[
retVal := actionValues at:actionIndex.
(retVal isKindOf:PopUpMenu) ifTrue:[
retVal := retVal startUp
]
]
] ifFalse:[
"/ mhmh an ST/X menu started the ST-80 way
menuView selectors notNil ifTrue:[
"/ (arg := menuView checkFlags at:selected) isNil ifTrue:[
sel0 := menuView selectors at:selected.
"/ ] ifFalse:[
"/ sel1 := menuView selectors at:selected.
"/ ].
"/ retVal := nil.
]
]
].
return := retVal
].
self showAtPointer.
"/
"/ mhmh an ST/X menu started the ST-80 way
"/
(sel0 notNil or:[sel1 notNil]) ifTrue:[
rec := menuView receiver.
sel0 notNil ifTrue:[
^ sel0
"/ rec perform:sel0
] ifFalse:[
^ Array with:sel1 with:arg.
"/ rec perform:sel1 with:arg.
]
].
^ return
"
Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp
Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')
values:#(foo bar baz)) startUp
"
!
startUpWithHeading:aString
"start the menu modal - return the selected value,
or - if no values where specified - return the index.
If nothing was selected, return 0.
Modal - i.e. stay in the menu until finished.
This is the ST-80 way of launching a menu."
defaultHideOnRelease := false.
menuView labels notNil ifTrue:[
menuView labels:(Array with:aString with:'=') , menuView labels.
].
menuView selectors notNil ifTrue:[
menuView selectors:(Array with:nil with:nil) , menuView selectors.
].
"/ menuView disable:1; disable:2.
^ self startUp.
"
(PopUpMenu
labels:#('foo' 'bar'))
startUp
"
"
(PopUpMenu
labels:#('foo' 'bar'))
startUpWithHeading:'hello'
"
! !
!PopUpMenu methodsFor:'event handling'!
buttonMotion:button x:x y:y
|p superMenu|
((x >= 0) and:[x < width]) ifTrue:[
((y >= 0) and:[y < height]) ifTrue:[
hideOnRelease := true.
menuView buttonMotion:button x:x y:y.
^ self
]
].
"outside of myself"
superMenu := menuView superMenu.
superMenu notNil ifTrue:[
p := device translatePoint:(x @ y)
from:drawableId
to:(menuView superMenu id).
superMenu buttonMotion:button x:p x y:p y
].
menuView subMenuShown isNil ifTrue:[
menuView pointerLeave:button.
].
hideOnLeave ifTrue:[
self hide
].
!
pointerEnter:state x:x y:y
"catch quick release of button"
hideOnLeave ifTrue:[
state == 0 ifTrue:[^ self hide].
]
!
pointerLeave:state
"/ menuView pointerLeave:state.
"/ hideOnLeave ifTrue:[
"/ self hide
"/ ].
"/ menuView superMenu notNil ifTrue:[
"/ menuView superMenu regainControl
"/ ]
!
buttonPress:button x:x y:y
hideOnRelease ifTrue:[
self hide.
"
menuView buttonRelease:button x:x y:y.
"
menuView superMenu notNil ifTrue:[
menuView superMenu submenuTriggered
].
menuView buttonRelease:button x:x y:y.
] ifFalse:[
hideOnRelease := true.
((x >= 0) and:[x < width]) ifTrue:[
((y >= 0) and:[y < height]) ifTrue:[
menuView buttonPress:button x:x y:y.
^ self
]
].
].
!
buttonRelease:button x:x y:y
hideOnRelease ifFalse:[
^ self
].
self hide.
"
menuView buttonRelease:button x:x y:y.
"
menuView superMenu notNil ifTrue:[
menuView superMenu submenuTriggered
].
menuView buttonRelease:button x:x y:y.
!
keyPress:key x:x y:y
"/ hideOnRelease := true.
menuView keyPress:key x:x y:y.
! !