"
 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

$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.7 1994-08-07 13:23:09 claus Exp $
'!

!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
"
$Header: /cvs/stx/stx/libwidg/PopUpMenu.st,v 1.7 1994-08-07 13:23:09 claus Exp $
"
!

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.

    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 middleButtonMenu of some view. (Views button-event handler
    will show it when the button is pressed ...)

        |v m|

        v := View new.
        m := PopUpMenu
                labels:#('lower'
                         'raise'
                         '-'
                         'destroy')
                selectors:#(#lower #raise nil #destroy)
                receiver:v.
        v middleButtonMenu:m.
        v open

    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:'instance creation'!

onSameDeviceAs:aView
    "this takes care of the device on which the view (for which
     the popup-menu is to be created) is located."

    aView isNil ifTrue:[
        ^ self on:Display
    ].
    ^ self on:(aView device)
!

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 receiver:anObject for:aView
    |newMenu|

    newMenu := self onSameDeviceAs:aView. 
    newMenu menu:(MenuView
                        labels:labels
                        selectors:selectors
                        receiver:anObject
                        in:newMenu).
    ^ newMenu
!

labels:labels selectors:selectors args:args receiver:anObject
    ^ self labels:labels 
        selectors:selectors 
             args:args 
         receiver:anObject 
              for:nil
!

labels:labels selectors:selectors args:args receiver:anObject for:aView
    |newMenu|

    newMenu := self onSameDeviceAs:aView. 
    newMenu menu:(MenuView
                    labels:labels
                    selectors:selectors
                    args:args
                    receiver:anObject
                    in:newMenu).
    ^ newMenu
!

labels:labels selector:aSelector args:args receiver:anObject
    ^ self labels:labels 
         selector:aSelector 
             args:args 
         receiver:anObject 
              for:nil
!

labels:labels selectors:selectors receiver:anObject
    ^ self labels:labels selectors:selectors receiver:anObject for:nil
!

labels:labels selector:aSelector args:args receiver:anObject for:aView
    |newMenu|

    newMenu := self onSameDeviceAs:aView. 
    newMenu menu:(MenuView
                    labels:labels
                    selector:aSelector
                    args:args
                    receiver:anObject
                    in:newMenu).
    ^ newMenu
! !

!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.
    style == #iris ifTrue:[
        borderWidth := 1
    ].
    (style == #st80) ifTrue:[
        viewBackground := White.
        borderWidth := 1.
        level := 0.
        margin := 0.
        shadowView := nil
    ].
!

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
"/    windowGroup notNil ifTrue:[
"/        windowGroup sensor compressMotionEvents:true
"/    ].

    menuView deselectWithoutRedraw.
"/    self enableEnterLeaveEvents.
    super realize.

"/    menuView disableButtonMotionEvents.
"/    menuView disableMotionEvents.
"/    menuView disableButtonEvents.
"/    menuView disableEnterLeaveEvents
! !

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

superMenu:aMenu
    "return the superMenu"

    menuView superMenu:aMenu
! !

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

font:aFont
    menuView font:aFont
!

labels
    "return the list of labels"

    actionLabels notNil ifTrue:[
        ^ actionLabels asText
    ].
    ^ menuView list
!

indexOf:indexOrName
    "return the index of a submenu - or 0 if there is none"

    ^ menuView indexOf:indexOrName
!

remove:indexOrName
    "remove a menu entry"

    menuView remove:indexOrName
!

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
!

addLabel:aLabel selector:aSelector after:indexOrName
    "add a new menu entry somewhere"

    menuView addLabel:aLabel selector:aSelector after:indexOrName
!

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
    "return a submenu - or nil if there is none"

    ^ menuView subMenuAt:indexOrName
!

subMenuAt:indexOrName put:aMenu
    "define a submenu to be shown for entry indexOrName"

"
    aMenu hideOnLeave:true.
"
    menuView subMenuAt:indexOrName put:aMenu.
    "tell the submenu to notify me when action is performed"
    aMenu superMenu:self.

    "|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
!

numberOfItems
    "return the number of items in the menu"

    actionLabels notNil ifTrue:[
        ^ actionLabels asText size
    ].
    ^ menuView list size
!

values
    "st-80 compatibility"

    ^ actionValues
!

lines
    "st-80 compatibility"

    ^ 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 resizing:aBoolean
    "realize the menu at aPoint"

    aBoolean ifTrue:[
        self fixSize.
    ].
    self origin:aPoint.
    self makeFullyVisible.
    self openModal:[true] "realize     "
!

showAt:aPoint
    "realize the menu at aPoint"

    self showAt:aPoint resizing:true 
!

showAtPointer
    "realize the menu at the current pointer position"

    self showAt:(device pointerPosition) resizing:true
!

show
    "realize the menu at its last position"

    self fixSize.
    self openModal:[true] "realize     "
!

hide
    "hide the menu - if there are any pop-up-submenus, hide them also"

    menuView hideSubmenu.
    windowGroup notNil ifTrue:[
        windowGroup removeView:self.
        windowGroup := nil.
    ].
    self unrealize.
!

XXregainControl
" "
    device ungrabPointer.
    device grabPointerIn:drawableId
" "
! !

!PopUpMenu methodsFor:'ST-80 activation'!

startUp
    "start the menu modal - return the selected value,
     or - if no values where specified - return the index.
     If nothing was selected, return 0.
     Modal - i.e. stay in the menu until finished.
     This is the ST-80 way of launching a menu."

    menuView action:[:selected |
        |actionIndex value|

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

    "
     Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')) startUp
     Transcript showCr:(PopUpMenu labels:#('foo' 'bar' 'baz')
                                  values:#(foo bar baz)) startUp
    "
! !

!PopUpMenu methodsFor:'events'!

buttonMotion:button x:x y:y
    |p|

    ((x >= 0) and:[x < width]) ifTrue:[
        ((y >= 0) and:[y < height]) ifTrue:[
            menuView buttonMotion:button x:x y:y.
            ^ self
        ]
    ].

    "outside of myself"
    menuView superMenu notNil ifTrue:[
        p := device translatePoint:(x @ y)
                              from:drawableId
                                to:(menuView superMenu id).
        menuView superMenu buttonMotion:button x:p x y:p y
    ].

    menuView subMenuShown isNil ifTrue:[
        menuView pointerLeave:button.
    ].

    hideOnLeave ifTrue:[
        self hide
    ].

"/    menuView superMenu notNil ifTrue:[
"/        menuView superMenu regainControl.
"/    ].
!

pointerEnter:state x:x y:y
    "catch quick release of button"

    state == 0 ifTrue:[^ self hide].
!

pointerLeave:state
"/    menuView pointerLeave:state.
"/    hideOnLeave ifTrue:[
"/        self hide
"/    ].
"/    menuView superMenu notNil ifTrue:[
"/        menuView superMenu regainControl
"/    ]
!

buttonRelease:button x:x y:y
    self hide.
"
    menuView buttonRelease:button x:x y:y.
"
    menuView superMenu notNil ifTrue:[
        menuView superMenu submenuTriggered 
    ].
    menuView buttonRelease:button x:x y:y.
! !