--- a/PopUpMenu.st Sun Aug 07 15:22:53 1994 +0200
+++ b/PopUpMenu.st Sun Aug 07 15:23:42 1994 +0200
@@ -19,51 +19,240 @@
!
PopUpMenu comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.6 1994-01-08 17:27:41 claus Exp $
-
-written summer 89 by claus;
-ST-80 compatibility added Dec 92;
+$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.7 1994-08-07 13:23:09 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.7 1994-08-07 13:23:09 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.
+
+ 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 middleButtonMenu of some view. (Views button-event handler
+ will show it when the button is pressed ...)
+
+ |v m|
+
+ v := View new.
+ m := PopUpMenu
+ labels:#('lower'
+ 'raise'
+ '-'
+ 'destroy')
+ selectors:#(#lower #raise nil #destroy)
+ receiver:v.
+ v middleButtonMenu:m.
+ v open
+
+ 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:'instance creation'!
+onSameDeviceAs:aView
+ "this takes care of the device on which the view (for which
+ the popup-menu is to be created) is located."
+
+ aView isNil ifTrue:[
+ ^ self on:Display
+ ].
+ ^ self on:(aView device)
+!
+
+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 receiver:anObject for:aView
|newMenu|
- aView isNil ifTrue:[
- newMenu := self on:Display
- ] ifFalse:[
- newMenu := self on:(aView device)
- ].
- ^ newMenu menu:(MenuView
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
labels:labels
- selectors:selectors
- receiver:anObject
- in:newMenu)
-!
-
-labels:labels selectors:selectors receiver:anObject
- ^ self labels:labels selectors:selectors receiver:anObject for:nil
-!
-
-labels:labels selectors:selectors args:args receiver:anObject for:aView
- |newMenu|
-
- aView isNil ifTrue:[
- newMenu := self on:Display
- ] ifFalse:[
- newMenu := self on:(aView device)
- ].
- ^ newMenu menu:(MenuView
- labels:labels
- selectors:selectors
- args:args
- receiver:anObject
- in:newMenu)
+ selectors:selectors
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
!
labels:labels selectors:selectors args:args receiver:anObject
@@ -72,6 +261,44 @@
args:args
receiver:anObject
for:nil
+!
+
+labels:labels selectors:selectors args:args receiver:anObject for:aView
+ |newMenu|
+
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
+ labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
+!
+
+labels:labels selector:aSelector args:args receiver:anObject
+ ^ self labels:labels
+ selector:aSelector
+ args:args
+ receiver:anObject
+ for:nil
+!
+
+labels:labels selectors:selectors receiver:anObject
+ ^ self labels:labels selectors:selectors receiver:anObject for:nil
+!
+
+labels:labels selector:aSelector args:args receiver:anObject for:aView
+ |newMenu|
+
+ newMenu := self onSameDeviceAs:aView.
+ newMenu menu:(MenuView
+ labels:labels
+ selector:aSelector
+ args:args
+ receiver:anObject
+ in:newMenu).
+ ^ newMenu
! !
!PopUpMenu class methodsFor:'ST-80 instance creation'!
@@ -109,6 +336,13 @@
style == #iris ifTrue:[
borderWidth := 1
].
+ (style == #st80) ifTrue:[
+ viewBackground := White.
+ borderWidth := 1.
+ level := 0.
+ margin := 0.
+ shadowView := nil
+ ].
!
initEvents
@@ -136,14 +370,18 @@
!
realize
+"/ windowGroup notNil ifTrue:[
+"/ windowGroup sensor compressMotionEvents:true
+"/ ].
+
menuView deselectWithoutRedraw.
- self enableEnterLeaveEvents.
+"/ self enableEnterLeaveEvents.
super realize.
- menuView disableButtonMotionEvents.
- menuView disableMotionEvents.
- menuView disableButtonEvents.
- menuView disableEnterLeaveEvents
+"/ menuView disableButtonMotionEvents.
+"/ menuView disableMotionEvents.
+"/ menuView disableButtonEvents.
+"/ menuView disableEnterLeaveEvents
! !
!PopUpMenu methodsFor:'private accessing'!
@@ -214,6 +452,18 @@
^ 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
+!
+
addLabel:aLabel selector:aSelector
"add a new menu entry to the end"
@@ -226,6 +476,12 @@
menuView addLabel:aLabel selector:aSelector arg:anArg
!
+addLabel:aLabel selector:aSelector after:indexOrName
+ "add a new menu entry somewhere"
+
+ menuView addLabel:aLabel selector:aSelector after:indexOrName
+!
+
labelAt:index put:aString
"change a menu entry"
@@ -354,13 +610,8 @@
self fixSize.
].
self origin:aPoint.
- ((top + height) > (device height)) ifTrue:[
- self top:(device height - height)
- ].
- ((left + width) > (device width)) ifTrue:[
- self left:(device width - width)
- ].
- self realize
+ self makeFullyVisible.
+ self openModal:[true] "realize "
!
showAt:aPoint
@@ -379,34 +630,39 @@
"realize the menu at its last position"
self fixSize.
- self realize
+ self openModal:[true] "realize "
!
hide
"hide the menu - if there are any pop-up-submenus, hide them also"
menuView hideSubmenu.
- ^ self unrealize
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self.
+ windowGroup := nil.
+ ].
+ self unrealize.
!
-regainControl
-"
+XXregainControl
+" "
device ungrabPointer.
device grabPointerIn:drawableId
-"
+" "
! !
!PopUpMenu methodsFor:'ST-80 activation'!
startUp
- "start the menu modal - return the selected selector,
- or - if no selectors where specified - the index.
+ "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"
-
- |actionIndex value|
+ Modal - i.e. stay in the menu until finished.
+ This is the ST-80 way of launching a menu."
menuView action:[:selected |
+ |actionIndex value|
+
menuView args isNil ifTrue:[
menuView selectors isNil ifTrue:[
^ 0
@@ -423,8 +679,13 @@
^ value
].
self showAtPointer.
- self modalLoop.
^ 0
+
+ "
+ Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp
+ Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')
+ values:#(foo bar baz)) startUp
+ "
! !
!PopUpMenu methodsFor:'events'!
@@ -432,21 +693,17 @@
buttonMotion:button x:x y:y
|p|
- (x >= 0) ifTrue:[
- (x < width) ifTrue:[
- (y >= 0) ifTrue:[
- (y < height) ifTrue:[
- menuView buttonMotion:button x:x y:y.
- ^ self
- ]
- ]
+ ((x >= 0) and:[x < width]) ifTrue:[
+ ((y >= 0) and:[y < height]) ifTrue:[
+ menuView buttonMotion:button x:x y:y.
+ ^ self
]
].
"outside of myself"
menuView superMenu notNil ifTrue:[
p := device translatePoint:(x @ y)
- from:(self id)
+ from:drawableId
to:(menuView superMenu id).
menuView superMenu buttonMotion:button x:p x y:p y
].
@@ -457,7 +714,11 @@
hideOnLeave ifTrue:[
self hide
- ]
+ ].
+
+"/ menuView superMenu notNil ifTrue:[
+"/ menuView superMenu regainControl.
+"/ ].
!
pointerEnter:state x:x y:y
@@ -467,13 +728,13 @@
!
pointerLeave:state
- menuView pointerLeave:state.
- hideOnLeave ifTrue:[
- self hide
- ].
- menuView superMenu notNil ifTrue:[
- menuView superMenu regainControl
- ]
+"/ menuView pointerLeave:state.
+"/ hideOnLeave ifTrue:[
+"/ self hide
+"/ ].
+"/ menuView superMenu notNil ifTrue:[
+"/ menuView superMenu regainControl
+"/ ]
!
buttonRelease:button x:x y:y