"

 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

'!

!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

"

"

!

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.