# $Id: combobut.tcl,v 2.5 2002/05/30 17:11:45 jfontain Exp $


class comboButton {}

proc comboButton::comboButton {this parentPath args} composite {
    [new arrowButton $parentPath -command "comboButton::popupListBox $this"] $args
} {
    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 $widget::option(menu,relief) -borderwidth $widget::option(menu,borderwidth)
    }
    bind $shellPath <Escape> "comboButton::unpopListBox $this"
    bind $shellPath <Any-ButtonRelease> "comboButton::unpopListBox $this"         ;# allow any mouse click outside shell to unpop it
    wm overrideredirect $shellPath 1                                                                ;# no window manager decorations
    wm withdraw $shellPath                                                                           ;# list is invisible by default

    composite::manage $this [new scrollList $shellPath] scroll
    # disallow focus display and listbox border so as to behave as a menu pane
    widget::configure $composite::($this,scroll) base -highlightthickness 0
    widget::configure $composite::($this,scroll) listbox -borderwidth 0
    pack $composite::($this,scroll,path) -fill both -expand 1

    set listboxPath $composite::($composite::($this,scroll),listbox,path)
    # a button release or a space bar hit within the listbox means a selection
    set sequence "comboButton::invokeCommand $this; comboButton::unpopListBox $this"
    bind $listboxPath <ButtonRelease-1> $sequence
    bind $listboxPath <KeyRelease-space> $sequence
    bind $listboxPath <Return> $sequence
    bind $listboxPath <KP_Enter> $sequence

    # just keep class bindings for scrollbar so that mouse action does not unpop the scrolled list
    bindtags $composite::($composite::($this,scroll),scrollbar,path) Scrollbar

    composite::complete $this
}

proc comboButton::~comboButton {this} {}

proc comboButton::options {this} {                                            ;# force initialization on list and listheight options
    return [list\
        [list -command {} {}]\
        [list -font $widget::option(button,font) $widget::option(button,font)]\
        [list -list {}]\
        [list -listheight 3]\
        [list -reference {} {}]\
        [list -state normal]\
        [list -takefocus {} {}]\
    ]
}

proc comboButton::set-command {this value} {}                                ;# do nothing, command is stored at the composite level

proc comboButton::set-font {this value} {
    widget::configure $composite::($this,scroll) -font $value
}

proc comboButton::set-list {this value} {
    if {[llength $value]==0} {
        widget::configure $composite::($this,base) -state disabled
    } else {
        widget::configure $composite::($this,base) -state normal
    }
    widget::configure $composite::($this,scroll) -list $value
}

foreach option {-state -takefocus} {
    proc comboButton::set$option {this value} "widget::configure \$composite::(\$this,base) $option \$value"
}

proc comboButton::set-listheight {this value} {
    widget::configure $composite::($this,scroll) -height $value
}

proc comboButton::set-reference {this value} {}                     ;# do nothing, reference widget is stored at the composite level

proc comboButton::set-borderwidth {this value} {
    widget::configure $composite::($this,base) -borderwidth $value
}

proc comboButton::popupListBox {this} {
    set shellPath $composite::($this,shell,path)
    if {[winfo exists $composite::($this,-reference)]} {
        set path $composite::($this,-reference)
        set border 0                           ;# use reference widget width eventually without including highlight border thickness
        catch {set border [$path cget -highlightthickness]}
        set x [expr {[winfo rootx $path]+$border}]
        wm geometry $shellPath [expr {[winfo width $path]-(2*$border)}]x[winfo reqheight $shellPath]
    } else {
        set path $widget::($this,path)
        set x [expr {[winfo rootx $path]+[winfo width $path]-[winfo reqwidth $shellPath]}]
    }
    if {$x<0} {
        set x 0
    }
    showTopLevel $shellPath +$x+[expr {[winfo rooty $path]+[winfo height $path]}]
    update idletasks
    raise $shellPath
    set (previousGrab) [grab current $shellPath]
    grab -global $shellPath
    set ($this,focus) [focus]
    focus $composite::($this,scroll,path)
}

proc comboButton::unpopListBox {this} {
    set path $composite::($this,shell,path)
    if {![winfo ismapped $path]} {                                                                               ;# already unpopped
        return
    }
    wm withdraw $path
    if {[string length $(previousGrab)]>0} {
        grab $(previousGrab)
        unset (previousGrab)
    } else {
        grab release $path
    }
    catch {focus $($this,focus)}                             ;# try to restore focus (only useful within safe interpreter emulation)
    unset ($this,focus)
}

proc comboButton::invokeCommand {this} {
    if {[string length $composite::($this,-command)]==0} {
        return
    }
    set selection [scrollList::curselection $composite::($this,scroll)]
    if {[string length $selection]==0} {
        uplevel #0 $composite::($this,-command) [list {}]                  ;# always invoke command at global level as tk buttons do
    } else {
        uplevel #0 $composite::($this,-command) [list [scrollList::get $composite::($this,scroll) $selection]]
    }
}
