# spinbox.tcl --
#
#	BWidget SpinBox implementation.
#
# Copyright (c) 1999 by Unifix
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
# 
# RCS: @(#) $Id: spinbox.tcl,v 1.10 2000/05/30 23:44:46 ericm Exp $
# -----------------------------------------------------------------------------
#  Index of commands:
#     - SpinBox::create
#     - SpinBox::configure
#     - SpinBox::cget
#     - SpinBox::setvalue
#     - SpinBox::_destroy
#     - SpinBox::_modify_value
#     - SpinBox::_test_options
# -----------------------------------------------------------------------------

namespace eval SpinBox {
    ArrowButton::use
    Entry::use

    Widget::tkinclude SpinBox frame :cmd \
	    include {-background -borderwidth -bg -bd -relief} \
	    initialize {-relief sunken -borderwidth 2}

    Widget::bwinclude SpinBox Entry .e \
        remove {-relief -bd -borderwidth -fg -bg} \
        rename {-foreground -entryfg -background -entrybg}

    Widget::declare SpinBox {
        {-range          String ""  0}
        {-values         String ""  0}
        {-modifycmd      String ""  0}
        {-repeatdelay    Int    400 0 {%d >= 0}}
        {-repeatinterval Int    100 0 {%d >= 0}}
	{-foreground     TkResource black 0 {button}}
    }

    Widget::addmap SpinBox "" :cmd {-background {}}
    Widget::addmap SpinBox ArrowButton .arrup {
        -foreground {} -background {} -disabledforeground {} -state {} \
		-repeatinterval {} -repeatdelay {}
    }
    Widget::addmap SpinBox ArrowButton .arrdn {
        -foreground {} -background {} -disabledforeground {} -state {} \
		-repeatinterval {} -repeatdelay {}
    }

    ::bind SpinBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
    ::bind SpinBox <Destroy> {SpinBox::_destroy %W}

    interp alias {} ::SpinBox {} ::SpinBox::create
    proc use {} {}

    variable _widget
}


# -----------------------------------------------------------------------------
#  Command SpinBox::create
# -----------------------------------------------------------------------------
proc SpinBox::create { path args } {
    array set maps [list SpinBox {} :cmd {} .e {} .arrup {} .arrdn {}]
    array set maps [Widget::parseArgs SpinBox $args]
    eval frame $path $maps(:cmd) -highlightthickness 0 \
	    -takefocus 0 -class SpinBox
    Widget::initFromODB SpinBox $path $maps(SpinBox)

    set entry [eval Entry::create $path.e $maps(.e) -relief flat -bd 0]
    bindtags $path.e [linsert [bindtags $path.e] 1 SpinBoxEntry]

    # Added by Cece when object would not take focus; copied from combobox.tcl
    ::bind $path.e <FocusIn> "$path _focus_in"
    ::bind $path.e <FocusOut> "$path _focus_out"

    set farr   [frame $path.farr -relief flat -bd 0 -highlightthickness 0]
    set height [expr {[winfo reqheight $path.e]/2-2}]
    set width  11
    set arrup  [eval ArrowButton::create $path.arrup -dir top \
	    $maps(.arrup) \
	    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
	    -type button \
	    -width $width -height $height \
	    -armcommand    [list "SpinBox::_modify_value $path next arm"] \
	    -disarmcommand [list "SpinBox::_modify_value $path next disarm"]]
    set arrdn  [eval ArrowButton::create $path.arrdn -dir bottom \
	    $maps(.arrdn) \
	    -highlightthickness 0 -borderwidth 1 -takefocus 0 \
	    -type button \
	    -width $width -height $height \
	    -armcommand    [list "SpinBox::_modify_value $path previous arm"] \
	    -disarmcommand [list "SpinBox::_modify_value $path previous disarm"]]

    # --- update SpinBox value ---
    _test_options $path
    set val [Entry::cget $path.e -text]
    if { [string equal $val ""] } {
	Entry::configure $path.e -text $::SpinBox::_widget($path,curval)
    } else {
	set ::SpinBox::_widget($path,curval) $val
    }

    # Added by Cece when object would not take focus; copied from combobox.tcl
    if { ![Widget::cget $path -editable] } {
	if { ![string equal [Widget::cget $path -state] "disabled"] } {
	    Entry::configure $path.e -takefocus 1
	}
    }

    grid $arrup -in $farr -column 0 -row 0 -sticky nsew
    grid $arrdn -in $farr -column 0 -row 2 -sticky nsew
    grid rowconfigure $farr 0 -weight 1
    grid rowconfigure $farr 2 -weight 1

    pack $farr  -side right -fill y
    pack $entry -side left  -fill both -expand yes

    ::bind $entry <Key-Up>    "SpinBox::_modify_value $path next activate"
    ::bind $entry <Key-Down>  "SpinBox::_modify_value $path previous activate"
    ::bind $entry <Key-Prior> "SpinBox::_modify_value $path last activate"
    ::bind $entry <Key-Next>  "SpinBox::_modify_value $path first activate"

    ::bind $farr <Configure> {grid rowconfigure %W 1 -minsize [expr {%h%%2}]}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval SpinBox::\$cmd $path \$args\]"

    return $path
}

# -----------------------------------------------------------------------------
#  Command SpinBox::configure
# -----------------------------------------------------------------------------
proc SpinBox::configure { path args } {
    set res [Widget::configure $path $args]
    if { [Widget::hasChangedX $path -values] ||
         [Widget::hasChangedX $path -range] } {
        _test_options $path
    }
    return $res
}


# -----------------------------------------------------------------------------
#  Command SpinBox::cget
# -----------------------------------------------------------------------------
proc SpinBox::cget { path option } {
    return [Widget::cget $path $option]
}


# -----------------------------------------------------------------------------
#  Command SpinBox::setvalue
# -----------------------------------------------------------------------------
proc SpinBox::setvalue { path index } {
    variable _widget

    set values [Widget::getMegawidgetOption $path -values]
    set value  [Entry::cget $path.e -text]
    
    if { [llength $values] } {
        # --- -values SpinBox ---
        switch -- $index {
            next {
                if { [set idx [lsearch $values $value]] != -1 } {
                    incr idx
                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
                    set idx [lsearch $values $_widget($path,curval)]
                }
            }
            previous {
                if { [set idx [lsearch $values $value]] != -1 } {
                    incr idx -1
                } elseif { [set idx [lsearch $values "$value*"]] == -1 } {
                    set idx [lsearch $values $_widget($path,curval)]
                }
            }
            first {
                set idx 0
            }
            last {
                set idx [expr {[llength $values]-1}]
            }
            default {
                if { [string index $index 0] == "@" } {
                    set idx [string range $index 1 end]
                    if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
                        return -code error "bad index \"$index\""
                    }
                } else {
                    return -code error "bad index \"$index\""
                }
            }
        }
        if { $idx >= 0 && $idx < [llength $values] } {
            set newval [lindex $values $idx]
        } else {
            return 0
        }
    } else {
        # --- -range SpinBox ---
	foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] {
	    break
	}
	# Allow zero padding on the value; strip it out for calculation by
	# scanning the value into a floating point number.
	scan $value %f value
        switch -- $index {
            next {
                if { [catch {expr {double($value-$vmin)/$incr}} idx] } {
                    set newval $_widget($path,curval)
                } else {
                    set newval [expr {$vmin+(round($idx)+1)*$incr}]
                    if { $newval < $vmin } {
#                        set newval $vmin
                        set newval $vmax
                    } elseif { $newval > $vmax } {
#                        set newval $vmax
                        set newval $vmin
                    }
                }
            }
            previous {
                if { [catch {expr {double($value-$vmin)/$incr}} idx] } {
                    set newval $_widget($path,curval)
                } else {
                    set newval [expr {$vmin+(round($idx)-1)*$incr}]
                    if { $newval < $vmin } {
#                        set newval $vmin
                        set newval $vmax
                    } elseif { $newval > $vmax } {
#                        set newval $vmax
                        set newval $vmin
                    }
                }
            }
            first {
                set newval $vmin
            }
            last {
                set newval $vmax
            }
            default {
                if { [string index $index 0] == "@" } {
                    set idx [string range $index 1 end]
                    if { [catch {string compare [expr {int($idx)}] $idx} res] || $res != 0 } {
                        return -code error "bad index \"$index\""
                    }
                    set newval [expr {$vmin+int($idx)*$incr}]
                    if { $newval < $vmin || $newval > $vmax } {
                        return 0
                    }
                } else {
                    return -code error "bad index \"$index\""
                }
            }
        }
    }
    set _widget($path,curval) $newval
    Entry::configure $path.e -text $newval
    return 1
}


# -----------------------------------------------------------------------------
#  Command SpinBox::getvalue
# -----------------------------------------------------------------------------
proc SpinBox::getvalue { path } {
    variable _widget

    set values [Widget::getMegawidgetOption $path -values]
    set value  [Entry::cget $path.e -text]

    if { [llength $values] } {
        # --- -values SpinBox ---
        return  [lsearch $values $value]
    } else {
	foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] {
	    break
	}
        if { ![catch {expr {double($value-$vmin)/$incr}} idx] &&
             $idx == int($idx) } {
            return [expr {int($idx)}]
        }
        return -1
    }
}


# -----------------------------------------------------------------------------
#  Command SpinBox::bind
# -----------------------------------------------------------------------------
proc SpinBox::bind { path args } {
    return [eval ::bind $path.e $args]
}


# -----------------------------------------------------------------------------
#  Command SpinBox::_destroy
# -----------------------------------------------------------------------------
proc SpinBox::_destroy { path } {
    variable _widget

    unset _widget($path,curval)
    Widget::destroy $path
    rename $path {}
}


# -----------------------------------------------------------------------------
#  Command SpinBox::_modify_value
# -----------------------------------------------------------------------------
proc SpinBox::_modify_value { path direction reason } {
    if { $reason == "arm" || $reason == "activate" } {
        SpinBox::setvalue $path $direction
    }
    if { ($reason == "disarm" || $reason == "activate") &&
         [set cmd [Widget::getMegawidgetOption $path -modifycmd]] != "" } {
        uplevel \#0 $cmd
    }
}

# -----------------------------------------------------------------------------
#  Command SpinBox::_test_options
# -----------------------------------------------------------------------------
proc SpinBox::_test_options { path } {
    set values [Widget::getMegawidgetOption $path -values]
    if { [llength $values] } {
        set ::SpinBox::_widget($path,curval) [lindex $values 0]
    } else {
	foreach {vmin vmax incr} [Widget::getMegawidgetOption $path -range] {
	    break
	}
	set update 0
        if { [catch {expr {int($vmin)}}] } {
            set vmin 0
	    set update 1
        }
        if { [catch {expr {$vmax<$vmin}} res] || $res } {
            set vmax $vmin
	    set update 1
        }
        if { [catch {expr {$incr<0}} res] || $res } {
            set incr 1
	    set update 1
        }
	# Only do the set back (which is expensive) if we changed a value
	if { $update } {
	    Widget::setMegawidgetOption $path -range [list $vmin $vmax $incr]
	}
        set ::SpinBox::_widget($path,curval) $vmin
    }
}

# ----------------------------------------------------------------------------
#  Command SpinBox::_focus_in
    # Added by Cece when object would not take focus; copied from combobox.tcl
# ----------------------------------------------------------------------------
proc SpinBox::_focus_in { path } {
    variable background
    variable foreground

    if { [Widget::cget $path -editable] == 0 } {
        set value  [Entry::cget $path.e -text]
        if {[string equal $value ""]} {
            # If the entry is empty, we need to do some magic to
            # make it "selected"
            if {[$path.e cget -bg] != [$path.e cget -selectbackground]} {
                # Copy only if we know that this is not the selection
                # background color (by accident... focus out without
                # focus in etc.
                set background [$path.e cget -bg]
                set foreground [$path.e cget -fg]
            }
            $path.e configure -bg [$path.e cget -selectbackground]
            $path.e configure -fg [$path.e cget -selectforeground]
        }
    }
    $path.e selection clear
    $path.e selection range 0 end
}


# ----------------------------------------------------------------------------
#  Command SpinBox::_focus_out
    # Added by Cece when object would not take focus; copied from combobox.tcl
# ----------------------------------------------------------------------------
proc SpinBox::_focus_out { path } {
    variable background
    variable foreground

    if { [Widget::cget $path -editable] == 0 } {
        if {[info exists background]} {
            $path.e configure -bg $background
            $path.e configure -fg $foreground
            unset background
            unset foreground
        }
    }
}
