"
 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.20 1995-05-10 02:30:00 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.20 1995-05-10 02:30:00 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
!

change:aSymbol
    menuView change:aSymbol
!

changeMessage
    ^ 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'!

viewBackground:aColor
    "this is a kludge and will vanish ..."

    super viewBackground:aColor.
    menuView viewBackground:aColor
!

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
!

font:aFont
    menuView font:aFont
!

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
!

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:[
	    rec perform:sel0
	] ifFalse:[
	    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.
! !