# $Id: optimenu.tcl,v 2.10 2006/10/28 11:18:02 jfontain Exp $


class optionMenu {}

proc optionMenu::optionMenu {this parentPath args} composite {
    [new frame $parentPath -relief $widget::option(button,relief) -borderwidth $widget::option(button,borderwidth)] $args
} {
    set path $widget::($this,path)
    grid rowconfigure $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1
    composite::manage $this [new label $path -padx 0 -pady 0] label
    grid $composite::($this,label,path) -column 0 -row 0 -sticky nsew
    # separate label from stub with border width value so that shell when popped does not hide part of the stub
    grid columnconfigure $path 1 -minsize $widget::option(button,borderwidth)
    # use a frame instead of a button which does not accept pixel sizes
    composite::manage $this [new frame $path\
        -background $widget::option(button,background) -relief $widget::option(button,relief)\
        -borderwidth $widget::option(button,borderwidth) -width 12 -height 8\
    ] stub
    set stubPath $composite::($this,stub,path)
    grid $stubPath -column 2 -row 0
    grid columnconfigure $path 3 -minsize 8

    # setup bindings for activation highlighting
    bind $path <Enter> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,activebackground)}"
    bind $path <Leave> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,background)}"

    composite::manage $this [new toplevel [winfo toplevel $parentPath] -cursor right_ptr] shell
    set shellPath $composite::($this,shell,path)
    if {$widget::option(menu,borderwidth)==0} {                ;# use a thin black border for popup window, such as in windows menus
        $shellPath configure -highlightbackground black -highlightthickness 1
    } else {                                                                                       ;# use a border, such as in motif
        $shellPath configure -relief raised -borderwidth $widget::option(menu,borderwidth)                   ;# for Windows and UNIX
    }
    wm overrideredirect $shellPath 1                              ;# no window manager decorations, choices are invisible by default
    wm withdraw $shellPath

    global embed_args
    if {[info exists embed_args]} {
        # running in the plug-in environment, menu emulation is not possible since grab command is not yet available
        set sequence <ButtonRelease-1>
    } else {       ;# if not running in the plug-in environment, act as a menu and allow button press in label to pop up the choices
        set sequence <ButtonPress-1>
        bind $composite::($this,label,path) $sequence "optionMenu::popChoices $this"
    }
    bind $path $sequence "optionMenu::popChoices $this"
    bind $composite::($this,stub,path) $sequence "optionMenu::popChoices $this"
    set ($this,selectedLabelIndex) 0
    composite::complete $this
}

proc optionMenu::~optionMenu {this} {}

proc optionMenu::options {this} {
    return [list\
        [list -choices {} {}]\
        [list -command {} {}]\
        [list -font $widget::option(menu,font) $widget::option(menu,font)]\
        [list -popupcommand {} {}]\
        [list -takefocus 1]\
        [list -text {} {}]\
    ]
}

proc optionMenu::set-command {this value} {}
proc optionMenu::set-popupcommand {this value} {}

proc optionMenu::set-font {this value} {
    $composite::($this,label,path) configure -font $value
    set-choices $this $composite::($this,-choices)                      ;# geometry management must be updated according to new font
}

proc optionMenu::set-text {this value} {
    $composite::($this,label,path) configure -text $value
}

proc optionMenu::set-choices {this value} {
    set path $composite::($this,shell,path)
    eval destroy [winfo children $path]                                                              ;# destroy current labels first
    set index 0
    set width 0
    foreach choice $composite::($this,-choices) {
        set label [label $path.$index -text $choice -relief flat -font $composite::($this,-font)]
        if {[winfo reqwidth $label]>$width} {
            set width [winfo reqwidth $label]
        }
        bind $label <Enter> "optionMenu::select $this $index"
        pack $label -fill x
        incr index
    }
    grid columnconfigure $widget::($this,path) 0 -minsize $width                 ;# find maximum width and apply it to visible label
}

proc optionMenu::set-takefocus {this value} {
    set path $widget::($this,path)
    switch $value {
        0 {
            bind $path <space> {}
            bind $path <Return> {}
            bind $path <KP_Enter> {}
            bind $path <Up> {}
            bind $path <Down> {}
            bind $path <Escape> {}
        }
        1 {
            bind $path <space> "optionMenu::processSpaceKey $this"
            bind $path <Return> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
            bind $path <KP_Enter> [bind $path <Return>]
            bind $path <Up> "optionMenu::selectPrevious $this"
            bind $path <Down> "optionMenu::selectNext $this"
            bind $path <Escape> "optionMenu::unpopChoices $this"
        }
        default {
            error "bad takefocus value \"$value\": must be 0 or 1"
        }
    }
    $path configure -takefocus $value
}

proc optionMenu::popChoices {this} {
    if {\
        ([llength $composite::($this,-choices)] == 0) ||\
        (([string length $composite::($this,-popupcommand)] > 0) && ![uplevel #0 $composite::($this,-popupcommand)])\
    } return                                                                     ;# user code may cancel popping up the choices menu
    update idletasks                                                                                  ;# make sure sizes are correct
    set shellPath $composite::($this,shell,path)

    set selected [lindex [winfo children $composite::($this,shell,path)] $($this,selectedLabelIndex)]
    $selected configure -background $widget::option(menu,activebackground) -foreground $widget::option(menu,activeforeground)\
        -relief $widget::option(menu,relief)

    set labelPath $composite::($this,label,path)  ;# position selected label center at the same abscissa of the display label center
    set x [expr {[winfo rootx $labelPath]-$widget::option(menu,borderwidth)}]
    if {$x<0} {set x 0}
    set y [expr {[winfo rooty $labelPath]+(([winfo height $labelPath]-[winfo height $selected])/2)-[winfo y $selected]}]
    if {$y<0} {set y 0}
    # make sure choices width is identical to label width
    showTopLevel $shellPath\
        [expr {[winfo width $labelPath]+(2*$widget::option(menu,borderwidth))}]x[winfo reqheight $shellPath]+$x+$y
    update idletasks
    raise $shellPath
    set (previousGrab) [grab current $shellPath]
    global embed_args
    if {[info exists embed_args]} {                    ;# running in the plug-in environment, grab does not work yet and is emulated
        bind $shellPath <ButtonRelease-1> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
        grab $shellPath
    } else {
        # add a small delay before allowing a button release to unpop the shell so that a rapid press / release sequence leaves the
        # shell popped to emulate the Motif behavior
        after 300 "bind $shellPath <ButtonRelease-1> {optionMenu::unpopChoices $this; optionMenu::checkSelection $this}"
        grab -global $shellPath
    }
}

proc optionMenu::unpopChoices {this} {
    set path $composite::($this,shell,path)
    if {![winfo ismapped $path]} {
        return                                                                                                   ;# already unpopped
    }
    wm withdraw $path
    if {[string length $(previousGrab)]>0} {
        grab $(previousGrab)
        unset (previousGrab)
    } else {
        grab release $path
    }
    bind $path <ButtonRelease-1> {}
}

proc optionMenu::checkSelection {this} {
    set selected [lindex [winfo children $composite::($this,shell,path)] $($this,selectedLabelIndex)]
    if {[string length $selected]==0} return
    set selection [$selected cget -text]
    composite::configure $this -text $selection                            ;# use composite layer so that cget returns current value
    invokeCommand $this $selection
}

proc optionMenu::invokeCommand {this choice} {
    if {[string length $composite::($this,-command)]>0} {
        uplevel #0 $composite::($this,-command) [list $choice]             ;# always invoke command at global level as tk buttons do
    }
}

proc optionMenu::configureChoices {this args} {
    foreach label [winfo children $composite::($this,shell,path)] {
        eval $label configure $option $args
    }
}

proc optionMenu::select {this index} {
    if {![winfo ismapped $composite::($this,shell,path)]} {
        return                                                           ;# no selection should be allowed if choices are not posted
    }
    set labels [winfo children $composite::($this,shell,path)]
    if {$index<0} {
        set index 0
    } elseif {$index>=[llength $labels]} {
        set index [expr {[llength $labels]-1}]
    }
    [lindex $labels $($this,selectedLabelIndex)] configure -background $widget::option(menu,background)\
        -foreground $widget::option(menu,foreground) -relief flat
    [lindex $labels $index] configure -background $widget::option(menu,activebackground)\
        -foreground $widget::option(menu,activeforeground) -relief $widget::option(menu,relief)
    set ($this,selectedLabelIndex) $index
}

proc optionMenu::selectPrevious {this} {
    select $this [expr {$($this,selectedLabelIndex)-1}]
}

proc optionMenu::selectNext {this} {
    select $this [expr {$($this,selectedLabelIndex)+1}]
}

proc optionMenu::processSpaceKey {this} {
    if {[winfo ismapped $composite::($this,shell,path)]} {
        unpopChoices $this
        checkSelection $this
    } else {
        popChoices $this
    }
}
