"

 COPYRIGHT (c) 1997 by eXept Software AG

              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.

"

SimpleView subclass:#MenuPanel

	instanceVariableNames:'style adornment shadowView mapTime mustRearrange superMenu

		shortKeyInset selection items groupSizes receiver enableChannel

		menuHolder enabled'

	classVariableNames:'InitialSelectionQuerySignal DefaultStyle DefaultAdornment

		GroupDividerSize'

	poolDictionaries:''

	category:'Views-Menus'

!

Object subclass:#Item

	instanceVariableNames:'layout menuPanel subMenu adornment rawLabel enableChannel nameKey

		accessCharacterPosition value label activeHelpKey submenuChannel

		disabledImage'

	classVariableNames:'HorizontalInset VerticalInset LabelRightOffset ShortcutKeyOffset

		IndicatorOn IndicatorOff'

	poolDictionaries:''

	privateIn:MenuPanel

!

Object subclass:#Adornment

	instanceVariableNames:'indication accessCharacterPosition shortcutKey argument'

	classVariableNames:''

	poolDictionaries:''

	privateIn:MenuPanel::Item

!

!MenuPanel class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 by eXept Software AG

              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 panel used for both pull-down-menus and pop-up-menus.

    not yet finished MenuPanel class - this will eventually replace

    most of the MenuView and PopUpMenu stuff.

    (and hopefully be ST-80 compatible ...)

    To create a menu, there exists a MenuEditor which will generate

    a menu specification.

    [author:]

        Claus Atzkern

    [see also:]

        Menu

        MenuItem

        MenuEditor

"

!

examples

"

    start as PullDownMenu

                                                                                [exBegin]

    |top subView mview desc s1 s2 s3 img lbs labels|

    top := StandardSystemView new.

    mview := MenuPanel in:top.

    labels := #( 'foo' 'bar' 'baz' 'test' 'claus' ).

    mview level:2.

    mview verticalLayout:false.

    img := Image fromFile:'bitmaps/SBrowser.xbm'.

    lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test' with:'ludwig'.

    mview labels:lbs.

    mview shortcutKeyAt:2 put:#Cut.

    mview accessCharacterPositionAt:1 put:1.

    mview accessCharacterPositionAt:2 put:2.

    mview enabledAt:5 put:false.

    mview groupSizes:#( 2 2 ).

    s1 := MenuPanel labels:labels.

    s1 accessCharacterPositionAt:1 put:1.

    s1 accessCharacterPositionAt:2 put:2.

    s1 groupSizes:#( 2 2 ).

    s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).

    s3 := MenuPanel labels:lbs.

    s1 subMenuAt:2 put:s2.

    s1 subMenuAt:3 put:(MenuPanel labels:lbs).

    s2 subMenuAt:3 put:s3.

    s3 subMenuAt:3 put:(MenuPanel labels:labels).

    s3 shortcutKeyAt:3 put:$q.

    mview subMenuAt:1 put:s1.

    mview subMenuAt:4 put:(MenuPanel labels:lbs).

    (mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.

    s1 shortcutKeyAt:1 put:#Copy.

    s1 shortcutKeyAt:3 put:#Paste.

    mview subMenuAt:2 put:(MenuPanel labels:labels).

    top extent:(400 @ (mview height)).

    top open.

                                                                                [exEnd]

    start as PopUpMenu

                                                                                [exBegin]

    |subView mview desc s1 s2 s3 img lbs labels|

    mview := MenuPanel new.

    labels := #( 'foo' 'bar' 'baz' ).

    mview level:2.

    img := Image fromFile:'bitmaps/SBrowser.xbm'.

    lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test'.

    mview labels:lbs.

    s1 := MenuPanel labels:labels.

    s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).

    s3 := MenuPanel labels:lbs.

    s1 subMenuAt:2 put:s2.

    s1 subMenuAt:3 put:(MenuPanel labels:lbs).

    s2 subMenuAt:3 put:s3.

    s3 subMenuAt:3 put:(MenuPanel labels:labels).

    s3 shortcutKeyAt:3 put:$q.

    mview subMenuAt:1 put:s1.

    mview subMenuAt:4 put:(MenuPanel labels:lbs).

    (mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.

    s1 shortcutKeyAt:1 put:#Copy.

    s1 shortcutKeyAt:3 put:#Paste.

    mview subMenuAt:2 put:(MenuPanel labels:labels).

    mview startUp

                                                                                [exEnd]

    start from menu spec

                                                                                [exBegin]

    |menu|

    menu := MenuPanel menu:

        #(#Menu #( #(#MenuItem 

                    #label: 'File' 

                    #submenu:

                      #(#Menu #(#(#MenuItem #label: 'quit' #value:#quit )     

                                 (#MenuItem 

                                    #label: 'edit' 

                                    #submenu:

                                      #(#Menu #( #(#MenuItem #label: 'edit'  #value:#edit )     

                                                 #(#MenuItem #label: 'close' #value:#close)     

                                               )

                                               nil

                                               nil

                                       )     

                                  )

                                 #(#MenuItem #label: 'help' #value:#help )     

                               )

                               nil

                               nil

                       )     

                 ) 

                #(#MenuItem #label: 'Inspect' #value:#inspectMenu ) 

                #(#MenuItem #label: 'Bar' 

                            #submenu:

                               #(#Menu #( #(#MenuItem #label: 'bar 1' #value:#bar1 )     

                                          #(#MenuItem #label: 'bar 2' #value:#bar2 )     

                                        )

                                        nil

                                        nil

                                )     

                 ) 

              ) 

              #( 2 )

              nil

         ) decodeAsLiteralArray.  

    menu verticalLayout:false.

    Transcript showCR:(menu startUp).

                                                                                [exEnd]

"

! !

!MenuPanel class methodsFor:'instance creation'!

fromSpec:aSpec

    ^ self fromSpec:aSpec receiver:nil

!

fromSpec:aSpec receiver:aReceiver

    |menu|

    aSpec notNil ifTrue:[

        menu := Menu new.

        menu fromLiteralArrayEncoding:aSpec.

    ].

  ^ self menu:menu receiver:aReceiver

!

labels:labels

    ^ self labels:labels nameKeys:nil receiver:nil

!

labels:labels nameKeys:nameKeys

    ^ self labels:labels nameKeys:nameKeys receiver:nil

!

labels:labels nameKeys:nameKeys receiver:aReceiver

    |mview|

    mview := self menu:nil receiver:aReceiver.

    mview labels:labels.

    mview nameKeys:nameKeys.

  ^ mview

!

labels:labels receiver:aReceiver

    ^ self labels:labels nameKeys:nil receiver:aReceiver

!

menu:aMenu

    ^ self menu:aMenu receiver:nil

!

menu:aMenu receiver:aReceiver

    |mview|

    mview := self new.

    mview menu:aMenu.

"/ a menu itself may contain a receiver

"/ thus we do not overwrite the receiver

    aReceiver notNil ifTrue:[

        mview receiver:aReceiver

    ].

  ^ mview

! !

!MenuPanel class methodsFor:'class initialization'!

initialize

    InitialSelectionQuerySignal isNil ifTrue:[

        InitialSelectionQuerySignal := QuerySignal new.

    ].

"/    self updateStyleCache.

    DefaultAdornment isNil ifTrue:[

        DefaultAdornment := IdentityDictionary new.

        DefaultAdornment at:#showSeparatingLines     put:false.

        DefaultAdornment at:#showGroupDivider        put:true.

        DefaultAdornment at:#verticalLayout          put:true.

        DefaultAdornment at:#item                    put:nil.

        DefaultAdornment at:#value                   put:nil.

    ].

"

DefaultStyle := nil.

DefaultAdornment := nil.

self initialize

"

    "Modified: 4.7.1997 / 20:19:10 / cg"

!

updateStyleCache

    |fg bg menuStyle|

    DefaultStyle := IdentityDictionary new.

    menuStyle := MenuView styleSheet.

    DefaultStyle at:#foregroundColor         put:(fg := menuStyle colorAt:'menu.foregroundColor'         default:(Color black)).

    DefaultStyle at:#backgroundColor         put:(bg := menuStyle colorAt:'menu.backgroundColor'         default:(Color white)).

    DefaultStyle at:#hilightBackgroundColor  put:(menuStyle colorAt:'menu.hilightBackgroundColor'   default:fg).

    DefaultStyle at:#hilightForegroundColor  put:(menuStyle colorAt:'menu.hilightForegroundColor'   default:bg).

    DefaultStyle at:#disabledForegroundColor put:(menuStyle colorAt:'menu.disabledForegroundColor' default:(Color darkGray)).

    DefaultStyle at:#groupDividerSize        put:(menuStyle at:     'menu.groupDividerSize'        default:3).

    DefaultStyle at:#fitFirstPanel           put:(menuStyle at:     'menu.fitFirstPanel'           default:true).

    DefaultStyle at:#horizontalSpace         put:(menuStyle at:     'menu.horizontalSpace'         default:0).

    DefaultStyle at:#borderWidth             put:(menuStyle at:     'menu.borderWidth'             default:1).

    DefaultStyle at:#font                    put:(menuStyle at:     'menu.font'                    default:nil).

    "

     self updateStyleCache

    "

    "Created: / 4.7.1997 / 20:18:45 / cg"

    "Modified: / 27.10.1997 / 01:40:52 / cg"

! !

!MenuPanel class methodsFor:'private'!

subMenu:aSubMenu

    "create a submenu; can be redifined in derived classes

    "

  ^ (MenuPanel new) menu:aSubMenu.

! !

!MenuPanel methodsFor:'accept'!

accept

    "accept current selected item

    "

    ^ self accept:(self selection)

!

accept:anItem

    "this is the topMenu: accept item

    "

    |value item tgState itemIdx recv|

    self superMenu notNil ifTrue:[

        ^ self topMenu accept:anItem

    ].

    self selection:nil.

    self forceUngrabMouseAndKeyboard.

    (anItem notNil and:[anItem canAccept]) ifTrue:[

        tgState := anItem toggleIndication.

        itemIdx := anItem menuPanel findFirst:[:el| el == anItem ].

        item    := anItem.

        recv    := anItem menuPanel receiver.

    ].

    self isPopUpView ifFalse:[

        self do:[:el| el updateIndicators].

        self windowGroup processExposeEvents

    ] ifTrue:[

        self destroy

    ].

    value := self accept:item index:itemIdx toggle:tgState receiver:recv.

    self isPopUpView ifTrue:[

        self menuAdornmentAt:#value put:value.

        self menuAdornmentAt:#item  put:item

    ].

  ^ item.

!

accept:anItem index:anIndex toggle:aState receiver:aReceiver

    "accept an item

    "

    |value argument numArgs isKindOfValueModel|

    anItem isNil ifTrue:[

        self menuAdornmentAt:#hasPerformed put:true.

      ^ nil

    ].

    self menuAdornmentAt:#hasPerformed put:(aReceiver isKindOf:ValueModel).

    (value := anItem value) isNil ifTrue:[

        ^ anIndex

    ].

    (argument := anItem argument) isNil ifTrue:[

        argument := aState

    ].

    value isSymbol ifFalse:[

        (value respondsTo:#numArgs) ifTrue:[numArgs := value numArgs]

                                   ifFalse:[numArgs := 0].

        numArgs == 0 ifTrue:[

            value value

        ] ifFalse:[

            numArgs == 1 ifTrue:[value value:argument]

                        ifFalse:[value value:argument value:self]

        ].

        self menuAdornmentAt:#hasPerformed put:true.

      ^ anIndex

    ].

    aReceiver isNil ifTrue:[

        ^ value

    ].

    isKindOfValueModel := aReceiver isKindOf:ValueModel.

    (numArgs := value numArgs) == 0 ifTrue:[

        isKindOfValueModel ifFalse:[aReceiver perform:value]

                            ifTrue:[aReceiver value:value]

    ] ifFalse:[

        numArgs == 1 ifTrue:[

            isKindOfValueModel ifFalse:[aReceiver perform:value with:argument]

                                ifTrue:[aReceiver value:value value:argument]

        ] ifFalse:[

            isKindOfValueModel ifFalse:[aReceiver perform:value with:argument with:self]

                                ifTrue:[aReceiver value:value value:argument value:self]

        ]

    ].

    self menuAdornmentAt:#hasPerformed put:true.

  ^ value

!

lastItemAccepted

    "returns last item selected or nil

    "

  ^ self topMenu menuAdornmentAt:#item

!

lastValueAccepted

    "returns last value accepted or nil

    "

    |top|

    top := self topMenu.

    (top menuAdornmentAt:#hasPerformed) ~~ true ifTrue:[

        ^ self topMenu menuAdornmentAt:#value.

    ].

  ^ nil

! !

!MenuPanel methodsFor:'accessing'!

accessCharacterPositionAt:stringOrNumber

    "get the access character position for a textLabel

    "

  ^ self itemAt:stringOrNumber do:[:el| el accessCharacterPosition ]

!

accessCharacterPositionAt:stringOrNumber put:anIndexOrNil

    "get the access character position for a textLabel

    "

    self itemAt:stringOrNumber do:[:el| el accessCharacterPosition:anIndexOrNil ]

!

accessCharacterPositions

    "returns a collection of accessCharacterPosition's or nil

    "

    ^ self collect:[:anItem| anItem accessCharacterPosition ]

!

accessCharacterPositions:something

    "define accessCharacterPosition's for each item

    "

    self onEachPerform:#accessCharacterPosition: withArgList:something

!

args

    "returns a collection of argument's or nil

    "

    ^ self collect:[:anItem| anItem argument ]

!

args:something

    "define arguments for each item

    "

    self onEachPerform:#argument: withArgList:something

!

argsAt:stringOrNumber

    "gets the argument of an item or nil

    "

  ^ self itemAt:stringOrNumber do:[:el| el argument ]

!

argsAt:stringOrNumber put:anArgument

    "sets the argument of an item

    "

    self itemAt:stringOrNumber do:[:el| el argument:anArgument ]

!

groupSizes

    "gets collection of group sizes

    "

  ^ groupSizes

!

groupSizes:aGroupSizes

    "sets collection of group sizes

    "

    aGroupSizes = groupSizes ifFalse:[

        groupSizes := aGroupSizes copy.