"

 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'

       classVariableNames:''

       poolDictionaries:''

       category:'Views-Menus'

!

PopUpMenu comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

written summer 89 by claus;

ST-80 compatibility added Dec 92;

'!

!PopUpMenu class methodsFor:'instance creation'!

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

                        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)

!

labels:labels selectors:selectors args:args receiver:anObject

    ^ self labels:labels 

        selectors:selectors 

             args:args 

         receiver:anObject 

              for:nil

! !

!PopUpMenu class methodsFor:'ST-80 instance creation'!

labels:labels 

    ^ self labels:labels lines:nil values:nil 

!

labels:labels values:values 

    ^ self labels:labels lines:nil values:values 

!

labels:labels lines:lines 

    ^ self labels:labels lines:lines values:nil

!

labels:labels lines:lines values:values 

    ^ (self new) labels:labels lines:lines values:values 

!

labelList:labels values:values 

    ^ self labels:labels lines:nil values:values 

!

labelList:labels lines:lines values:values 

    ^ (self new) labels:labels lines:lines values:values 

! !

!PopUpMenu methodsFor:'initialization'!

initialize

    super initialize.

    memorize := true.

    hideOnLeave := false

!

initEvents

    super initEvents.

    self enableEnterLeaveEvents.

    self enableButtonMotionEvents.

    self enableMotionEvents.

    self enableButtonEvents

! !

!PopUpMenu methodsFor:'realization'!

fixSize

    "adjust my size to the size of the actual menu"

    |extra newWidth newHeight|

    extra := margin * 2.

    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.

    menuView disableButtonMotionEvents.

    menuView disableMotionEvents.

! !

!PopUpMenu methodsFor:'private accessing'!

menu:aMenu

    "set the actual menu"

    menuView := aMenu.

    menuView origin:(margin @ margin).

    menuView borderWidth:0

!

menuView

    "return the actual menu"

    ^ menuView

! !

!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

!

enable:anEntry

    "enable a menu entry"

    menuView enable:anEntry

!

disable:anEntry

    "disable a menu entry"

    menuView disable:anEntry

!

receiver:anObject

    menuView receiver:anObject

!

addLabel:aLabel selector:aSelector

    "add a new menu entry to the end"

    menuView addLabel:aLabel selector:aSelector

!

addLabel:aLabel selector:aSelector arg:anArg

    "add a new menu entry to the end"

    menuView addLabel:aLabel selector:aSelector arg:anArg

!

labelAt:index put:aString

    "change a menu entry"

    menuView labelAt:index put:aString

!

selectorAt:index put:aSymbol

    "change a selector entry"

    menuView selectorAt:index put:aSymbol

!

subMenuAt:indexOrName put:aMenu

    "define a submenu to be shown for entry indexOrName"

    aMenu hideOnLeave:true.

    "|v m|

     v := View new.

     m := PopUpMenu labels:#('1' '2' '3')

                 selectors:#(one two nil)

                  receiver:v

                       for:nil.

     m subMenuAt:3 put:(PopUpMenu

                             labels:#('a' 'b' 'c')

                          selectors:#(a b c)

                           receiver:v

                                for:nil).

     v middleButtonMenu:m.

     v realize"

!

checkToggleAt:index

    "return a checkToggles state"

    ^ menuView checkToggleAt:index

!

checkToggleAt:index put:aBoolean

    "set/clear a checkToggle"

    ^ menuView checkToggleAt:index put:aBoolean

! !

!PopUpMenu methodsFor:'ST-80 accessing'!

numberOfItems

    ^ actionLabels asText size

!

labels

    ^ actionLabels asText

!

values

    ^ actionValues

!

lines

    ^ 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 asText.

    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

                      selector:nil

                          args:argArray

                      receiver:nil 

                            in:self)

! !

!PopUpMenu methodsFor:'activation'!

showAt:aPoint

    "realize the menu at aPoint - return control"

    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

!

showAtPointer

    "realize the menu at the current pointer position - return control"

    self showAt:(device pointerPosition)

!

show

    "realize the menu at its last position - return control"

    self fixSize.

    self realize

!

hide

! !

!PopUpMenu methodsFor:'ST-80 activation'!

startUp

    "start the menu modal - return the selected selector,

     or - if no selectors where specified - the index.

     If nothing was selected, return 0.

     Modal - i.e. stay in the menu until finished"

    |actionIndex value|

    menuView action:[:selected |

        menuView args isNil ifTrue:[

            menuView selectors isNil ifTrue:[

                ^ 0

            ].

            ^ menuView receiver perform:(menuView selectors at:selected)

        ].

        actionIndex := menuView args at:selected.

        actionIndex isNil ifTrue:[^ 0].

        actionValues isNil ifTrue:[^ actionIndex].

        value := actionValues at:actionIndex.

        (value isKindOf:PopUpMenu) ifTrue:[

            ^ value startUp

        ].

        ^ value

    ].

    self showAtPointer.

    self modalLoop.

    ^ 0

! !

!PopUpMenu methodsFor:'events'!

buttonMotion:button x:x y:y

    (x >= 0) ifTrue:[

        (x < width) ifTrue:[

            (y >= 0) ifTrue:[

                (y < height) ifTrue:[

                    menuView buttonMotion:button x:x y:y.

                    ^ self

                ]

            ]

        ]

    ].

    hideOnLeave ifTrue:[

        self hide

    ]

!

pointerLeave:state

    menuView pointerLeave:state.

    hideOnLeave ifTrue:[

        self hide

    ]

!

buttonRelease:button x:x y:y

    self hide.

! !