"

 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.

"

SelectionInListView subclass:#MenuView

	 instanceVariableNames:'selectors args receiver enableFlags disabledFgColor onOffFlags

		subMenus subMenuShown superMenu checkColor lineLevel lineInset

		masterView hilightStyle needResize hideOnRelease'

	 classVariableNames:'DefaultFont DefaultCheckColor DefaultViewBackground

		DefaultForegroundColor DefaultBackgroundColor

		DefaultDisabledForegroundColor DefaultHilightForegroundColor

		DefaultHilightBackgroundColor DefaultHilightLevel

		DefaultHilightStyle DefaultHilightFrameColor DefaultLineLevel

		DefaultLineInset DefaultShadowColor DefaultLightColor'

	 poolDictionaries:''

	 category:'Views-Menus'

!

!MenuView 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.

"

!

documentation

"

    a menu view used for both pull-down-menus and pop-up-menus (and also,

    for nonModal menus, such as the Launchers click-menu).

    the action to be performed can be defined either as:

    1) action:aBlockWithOneArg

       which defines a block to be called with the line number (1..n)

       of the selected line.

    2) selectors:selectorArray [args: argArray] [receiver:anObject]

       which defines the messages to be sent to the model or

       receiver. Giving an explicit receiver overrides the model.

    It is also possible to define both actionBlock and selectorArray.

    The wellknown popups are created by wrapping a MenuView into an instance of

    PopUpMenu (read the description of popupmenu).

    menu entries starting with '\c' are check-entries.

    menu entries starting with '\b' are checkBox-entries.

    menu entries starting with '\t' are thumbUp/Down-entries.

    menu entries conisting of '-' alone, are separating lines.

    menu entries conisting of '=' alone, are double separating lines.

    StyleSheet defaults:

	menuFont                    font to use for menus

	menuViewBackground          view background (should be same as menuBackgroundColor)

	menuForegroundColor         foreground color

	menuBackgroundColor         background color

	menuShadowColor             shadow color for 3D effects

	menuLightColor              lightColor for 3D effects

	menuHilightForegroundColor  hilighted items foregroundColor

	menuHilightBackgroundColor  hilighted items backgroundColor

	menuHilightFrameColor       frame arounf hilighted items (or nil, if none)

				    defaults to selectionHilightFrameColor

	menuHilightLevel            3D level of selected items

	menuHilightStyle            #openwin or nil (special kludge)

	menuSeparatingLineLevel     3D level of sep. lines

	menuSeparatingLineInset     left/right inset of sep. lines

	menuDisabledForegroundColor foreground color of disabled items

	menuCheckColor              color to use for check marks

	menuFont                    font to use

    other values and some defaults are inherited via SelectionInListViews

    styles (i.e. look for selectionForegroundColor ...)

"

!

examples

"

    Examples:

	Notice: normally, menuviews are wrapped into either a popup-

	menu or pulldown-menu. But they can also be used stand-alone

	as in:

	|m|

	m := MenuView

		labels:#('foo'

			 'bar'

			 'baz')

		selectors:#(

			    #foo

			    #bar

			    #baz)

		receiver:nil.

	m open

"

! !

!MenuView class methodsFor:'instance creation'!

labels:labels

    "create and return a new MenuView. The parent view,

     selectors and receiver should be set later."

    ^ self labels:labels selectors:nil args:nil receiver:nil 

!

labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu

    "create and return a new MenuView

     - receiverObject gets message aSelector with argument from

       argArray for ALL entries"

    "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a

     single symbol-arg for selectors ..."

    ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:(aTopMenu superView)

!

labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu

    "create and return a new MenuView

     - receiverObject gets message aSelector with argument from

       argArray for all entries"

    "OBSOLETE protocol: labels:selectors:args:receiver: knows how to handle a

     single symbol-arg for selectors ..."

    ^ self labels:labels selectors:aSelector args:argArray receiver:anObject in:aTopMenu

!

labels:labels selectors:selArray

    "create and return a new MenuView. The parent veiw

     and receiver should be set later."

    ^ self labels:labels selectors:selArray args:nil receiver:nil 

!

labels:labels selectors:selArray args:argArray

    "create and return a new MenuView. The parent view

     should be set later."

    ^ self labels:labels selectors:selArray args:argArray

!

labels:labels selectors:selArray args:argArray receiver:anObject

    "create and return a new MenuView. The parent view

     should be set later."

    ^ (self new) 

	labels:labels

	selectors:selArray

	args:argArray 

	receiver:anObject

!

labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu

    "create and return a new MenuView for a topMenu"

    ^ self labels:labels selectors:selArray args:argArray receiver:anObject in:(aTopMenu superView)

!

labels:labels selectors:selArray args:argArray receiver:anObject in:aView

    "create and return a new MenuView in aView

     - receiverObject gets message from selectorArray with argument

       from argArray"

    ^ (self in:aView) 

	labels:labels 

	selectors:selArray

	args:argArray

	receiver:anObject

!

labels:labels selectors:selArray receiver:anObject

    "create and return a new MenuView. The parent view

     should be set later."

    ^ self labels:labels selectors:selArray args:nil receiver:anObject

!

labels:labels selectors:selArray receiver:anObject for:aTopMenu

    ^ self labels:labels selectors:selArray args:nil receiver:anObject for:aTopMenu

!

labels:labels selectors:selArray receiver:anObject in:aView

    "create and return a new MenuView in aView

     - receiverObject gets message from selectorArray without argument"

    ^ self labels:labels selectors:selArray args:nil receiver:anObject in:aView

! !

!MenuView class methodsFor:'defaults'!

updateStyleCache

    DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.

    DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.

    DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.

    DefaultShadowColor := StyleSheet colorAt:'menuShadowColor'.

    DefaultLightColor := StyleSheet colorAt:'menuLightColor'.

    DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.

    DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.

    DefaultHilightFrameColor := StyleSheet colorAt:'menuHilightFrameColor' 

				default:(StyleSheet colorAt:'selectionHilightFrameColor').

    DefaultHilightLevel := StyleSheet at:'menuHilightLevel'.

    DefaultHilightStyle := StyleSheet at:'menuHilightStyle'.

    DefaultLineLevel := StyleSheet at:'menuSeparatingLineLevel'.

    DefaultLineInset := StyleSheet at:'menuSeparatingLineInset'.

    DefaultDisabledForegroundColor := StyleSheet colorAt:'menuDisabledForegroundColor' default:Color darkGrey.

    DefaultCheckColor := StyleSheet colorAt:'menuCheckColor'.

    DefaultFont := StyleSheet fontAt:'menuFont'.

! !

!MenuView methodsFor:'accessing-behavior'!

disable:indexOrName

    "disable an entry"

    self setEnable:indexOrName to:false

!

disableAll:collectionOfIndicesOrNames

    "disable an collection of entries"

    collectionOfIndicesOrNames do:[:entry |

	self disable:entry

    ]

!

enable:indexOrName

    "enable an entry"

    self setEnable:indexOrName to:true 

!

enableAll:collectionOfIndicesOrNames

    "enable an collection of entries"

    collectionOfIndicesOrNames do:[:entry |

	self enable:entry

    ]

!

hideOnRelease:aBoolean

    hideOnRelease := aBoolean

!

isEnabled:indexOrName

    |index|

    index := self indexOf:indexOrName.

    index ~~ 0 ifTrue:[

	enableFlags isNil ifTrue:[^ true].

	^ enableFlags at:index

    ].

    "ask submenus for convenience"

    (indexOrName isNumber not and:[subMenus notNil]) ifTrue:[

	subMenus do:[:m |

	    m notNil ifTrue:[

		m enable:indexOrName

	    ]

	]

    ]

!

setEnable:indexOrName to:aBoolean

    "enable/disable an entry"

    |index|

    index := self indexOf:indexOrName.

    index ~~ 0 ifTrue:[

	(enableFlags at:index) ~~ aBoolean ifTrue:[

	    enableFlags at:index put:aBoolean.

	    shown ifTrue:[

		self redrawLine:index

	    ]

	]

    ] ifFalse:[

	"try submenus for convenience"

	(indexOrName isNumber not and:[subMenus notNil]) ifTrue:[

	    subMenus do:[:m |

		m notNil ifTrue:[

		    m setEnable:indexOrName to:aBoolean

		]

	    ]

	]

    ]

! !

!MenuView methodsFor:'accessing-items'!

addLabel:aLabel selector:aSelector

    "add another label/selector pair"

    list isNil ifTrue:[

	list := Array with:aLabel

    ] ifFalse:[

	list := list copyWith:aLabel

    ].

    selectors := selectors copyWith:aSelector.

    enableFlags := enableFlags copyWith:true.

    shown ifTrue:[

	self resize

    ] ifFalse:[

	needResize := true

    ]

!

addLabel:aLabel selector:aSelector after:aLabelOrSelectorOrNumber 

    "insert another label/selector pair at some place.

     Being very friendly here, allowing label-string, selector or numeric

     index for the argument aLabelOrSelectorOrNumber.

     To be independent of the entries label, we recommend you use the selector

     as index; in systems which translate strings for national variants,

     this makes your code easier to maintain."

    ^ self addLabel:aLabel 

	   selector:aSelector 

	     before:(self indexOf:aLabelOrSelectorOrNumber) + 1

    "

     |v1 v2 v3 v4|

     v1 := CodeView new realize.

     v2 := CodeView new realize.

     v2 middleButtonMenu:

	v editMenu addLabel:'new entry' selector:#foo after:'paste'.

     v3 := CodeView new realize.

     v3 middleButtonMenu:

	v editMenu addLabel:'new entry' selector:#foo after:#others.

     v4 := CodeView new realize.

     v4 middleButtonMenu:

	v editMenu addLabel:'new entry' selector:#foo after:1.

    "

!

addLabel:aLabel selector:aSelector arg:anArg

    "add another label/selector/argument trio"

    list isNil ifTrue:[

	list := Array with:aLabel

    ] ifFalse:[

	list := list copyWith:aLabel

    ].

    selectors := selectors copyWith:aSelector.

    args := args copyWith:anArg.

    enableFlags := enableFlags copyWith:true.

    shown ifTrue:[

	self resize

    ] ifFalse:[

	needResize := true

    ]

!

addLabel:aLabel selector:aSelector before:aLabelOrSelectorOrNumber 

    "insert another label/selector pair at some place.

     Being very friendly here, allowing label-string, selector or numeric

     index for the argument aLabelOrSelectorOrNumber.

     To be independent of the entries label, we recommend you use the selector

     as index; in systems which translate strings for national variants,

     this makes your code easier to maintain."

    |idx|

    list isNil ifTrue:[

	^ self addLabel:aLabel selector:aSelector

    ].

    "

     be user friendly - allow both label or selector

     to be passed

    "

    idx := self indexOf:aLabelOrSelectorOrNumber.

    (idx between:1 and:list size) ifFalse:[

	"add to end"

	^ self addLabel:aLabel selector:aSelector

    ].

    list := list asOrderedCollection.

    list add:aLabel beforeIndex:idx.

    selectors := selectors asOrderedCollection.

    selectors add:aSelector beforeIndex:idx.

    enableFlags := enableFlags asOrderedCollection.

    enableFlags add:true beforeIndex:idx.

    subMenus notNil ifTrue:[

	subMenus := subMenus asOrderedCollection.

	subMenus add:nil beforeIndex:idx.

    ].

    args notNil ifTrue:[

	args := args asOrderedCollection.

	args add:nil beforeIndex:idx.

    ].

    shown ifTrue:[

	self resize

    ] ifFalse:[

	needResize := true

    ]

    "

     |v1 v2 v3 v4|

     v1 := CodeView new realize.

     v2 := CodeView new realize.

     v2 middleButtonMenu:

	(v2 editMenu) addLabel:'new entry' selector:#foo before:'paste'.

     v3 := CodeView new realize.

     v3 middleButtonMenu:

	(v3 editMenu) addLabel:'new entry' selector:#foo before:#again.

     v4 := CodeView new realize.

     v4 middleButtonMenu:

	(v4 editMenu) addLabel:'new entry' selector:#foo before:1.

    "

!

addLabels:moreLabels selectors:moreSelectors

    "add more labels and selectors at the end"

    list isNil ifTrue:[

	list := moreLabels

    ] ifFalse:[

	list := list , moreLabels

    ].

    selectors := selectors , moreSelectors.

    enableFlags := enableFlags , (Array new:moreLabels size withAll:true).

    shown ifTrue:[

	self resize

    ] ifFalse:[

	needResize := true

    ]

!

addLabels:moreLabels selectors:moreSelectors after:aLabelOrSelectorOrNumber 

    "insert more labels/selectors at some place.

     Being very friendly here, allowing label-string, selector or numeric

     index for the argument aLabelOrSelectorOrNumber.

     To be independent of the entries label, we recommend you use the selector

     as index; in systems which translate strings for national variants,

     this makes your code easier to maintain."

    ^ self addLabels:moreLabels 

	   selectors:moreSelectors 

	      before:(self indexOf:aLabelOrSelectorOrNumber) + 1

!

addLabels:moreLabels selectors:moreSelectors before:aLabelOrSelectorOrNumber 

    "insert more labels/selectors at some place.

     Being very friendly here, allowing label-string, selector or numeric

     index for the argument aLabelOrSelectorOrNumber.

     To be independent of the entries label, we recommend you use the selector

     as index; in systems which translate strings for national variants,

     this makes your code easier to maintain."

    |idx 

     i     "{ Class: SmallInteger }" 

     nMore "{ Class: SmallInteger }"|

    list isNil ifTrue:[

	^ self addLabels:moreLabels selectors:moreSelectors

    ].

    "

     be user friendly - allow both label or selector

     to be passed

    "

    idx := self indexOf:aLabelOrSelectorOrNumber.

    (idx between:1 and:list size) ifFalse:[

	"add to end"

	^ self addLabels:moreLabels selectors:moreSelectors