"
 COPYRIGHT (c) 1989-93 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-93 by Claus Gittinger
              All Rights Reserved

%W% %E%

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.
    menuView disableButtonEvents
! !

!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.
    menuView subMenuAt:indexOrName put:aMenu

    "|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
    "hide the menu"

    ^ self unrealize
! !

!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
                ]
            ]
        ]
    ].
    menuView pointerLeave:button.
    hideOnLeave ifTrue:[
        self hide
    ]
!

pointerLeave:state
    menuView pointerLeave:state.
    hideOnLeave ifTrue:[
        self hide
    ]
!

buttonRelease:button x:x y:y
    self hide.
    menuView buttonRelease:button x:x y:y
! !