# $Id: spinent.tcl,v 2.4 2002/05/30 17:13:10 jfontain Exp $


class spinEntry {}

proc spinEntry::spinEntry {this parentPath args} composite {
    [new frame $parentPath -highlightthickness $widget::option(button,highlightthickness)] $args
} {
    ::set path $widget::($this,path)
    # prevent the arrow buttons from ever getting the focus
    composite::manage $this [new entry $path -highlightthickness 0] entry\
        [new arrowButton $path\
            -takefocus 0 -command "spinEntry::decrease $this" -height 4 -highlightthickness 0\
            -repeatdelay $widget::option(scrollbar,repeatdelay)\
        ] decrease\
        [new arrowButton $path\
            -direction up -takefocus 0 -command "spinEntry::increase $this" -height 4 -highlightthickness 0\
            -repeatdelay $widget::option(scrollbar,repeatdelay)\
        ] increase

    # the following bindings get activated when either the main button or the entry get the focus
    bind $path <Return> "spinEntry::invoke $this"
    bind $path <KP_Enter> "spinEntry::invoke $this"
    bind $composite::($this,entry,path) <Return> "spinEntry::invoke $this"
    bind $composite::($this,entry,path) <KP_Enter> "spinEntry::invoke $this"

    # either entry or widget will get the focus so setup key bindings for both of them
    spinEntry::setupUpAndDownKeysBindings $this $path
    spinEntry::setupUpAndDownKeysBindings $this $composite::($this,entry,path)

    composite::complete $this
}

proc spinEntry::~spinEntry {this} {}

proc spinEntry::options {this} {                                            ;# force initialization on font, side and  state options
    return [list\
        [list -command {} {}]\
        [list -editable 1 1]\
        [list -font $widget::option(button,font)]\
        [list -justify $widget::option(entry,justify) $widget::option(entry,justify)]\
        [list -list {} {}]\
        [list -range {} {}]\
        [list -repeatdelay $widget::option(scrollbar,repeatdelay) $widget::option(scrollbar,repeatdelay)]\
        [list -side left]\
        [list -state normal]\
        [list -width $widget::option(entry,width) $widget::option(entry,width)]\
    ]
}

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

proc spinEntry::set-editable {this value} {
    setStatesAndBindings $this
}

proc spinEntry::set-list {this value} {
    if {$composite::($this,complete)} {
        error {option -orient cannot be set dynamically}
    }
    if {[string length [$composite::($this,entry,path) get]]==0} {           ;# if not done yet, initialize value with first element
        set $this [lindex $value 0]
    }
}

proc spinEntry::set-range {this value} {
    if {$composite::($this,complete)} {
        error {option -range cannot be set dynamically}
    }
    if {[llength $value]!=3} {
        error {option -range argument format must be {minimum maximum increment}}
    }
    ::set ($this,minimum) [lindex $composite::($this,-range) 0]
    ::set ($this,maximum) [lindex $composite::($this,-range) 1]
    ::set ($this,increment) [lindex $composite::($this,-range) 2]
    if {[catch {expr {$($this,maximum)-$($this,minimum)+$($this,increment)}}]} {
        error {option -range arguments must be numeric values}
    }
    if {[string length [$composite::($this,entry,path) get]]==0} {                 ;# if not done yet, initialize value with minimum
        set $this $($this,minimum)
    }
}

proc spinEntry::set-repeatdelay {this value} {
    widget::configure $composite::($this,decrease) -repeatdelay $value
    widget::configure $composite::($this,increase) -repeatdelay $value
}

proc spinEntry::set-state {this value} {
    if {![regexp {^(disabled|normal)$} $value]} {
        error "bad state value \"$value\": must be normal or disabled"
    }
    setStatesAndBindings $this
}

foreach option {-font -justify -width} {
    proc spinEntry::set$option {this value} "\$composite::(\$this,entry,path) configure $option \$value"
}

proc spinEntry::set-side {this value} {                          ;# specifies on which side of the arrow buttons the entry should be
    if {![regexp {^(left|right)$} $value]} {
        error "bad side value \"$value\": must be left or right"
    }
    pack forget $composite::($this,entry,path) $composite::($this,increase,path) $composite::($this,decrease,path)
    pack $composite::($this,entry,path) -side $value -fill both -expand 1
    pack $composite::($this,increase,path) $composite::($this,decrease,path) -fill y -expand 1
}

# only now that the widget is in a final state (since the user was able to interact with it) can we do some validity checking
proc spinEntry::decrease {this} {
    set $this [spinEntry::next $this -1]
    invoke $this
}
proc spinEntry::increase {this} {
    set $this [spinEntry::next $this 1]
    invoke $this
}

proc spinEntry::next {this direction} {
    ::set value [$composite::($this,entry,path) get]
    if {[catch {::set ($this,increment)} increment]} {                                                                  ;# list mode
        ::set index [lsearch -exact $composite::($this,-list) $value]                         ;# try to find the current value index
        incr index $direction                                         ;# note: if not found, we restart at the beginning of the list
        if {$index<0} {
            return [lindex $composite::($this,-list) 0]
        } elseif {$index>=[llength $composite::($this,-list)]} {
            return [lindex $composite::($this,-list) end]
        } else {
            return [lindex $composite::($this,-list) $index]
        }
    } else {                                                                                                           ;# range mode
        ::set minimum $($this,minimum)
        ::set maximum $($this,maximum)
        if {[catch {expr {$value+0}}]} {                                 ;# if entry is editable, contents may not be a valid number
            return [expr {$direction<0?$minimum:$maximum}]
        } else {
            ::set value [expr {$value+($direction*$increment)}]
            if {$value<=$minimum} {
                return $minimum
            } elseif {$value>=$maximum} {
                return $maximum
            } else {
                return $value
            }
        }
    }
}

proc spinEntry::setStatesAndBindings {this} {
    if {[string equal $composite::($this,-state) normal]} {
        widget::configure $composite::($this,decrease) -state normal
        widget::configure $composite::($this,increase) -state normal
        if {$composite::($this,-editable)} {
            $widget::($this,path) configure -takefocus 0                                                  ;# let entry get the focus
            $composite::($this,entry,path) configure -state normal
        } else {
            $widget::($this,path) configure -takefocus 1                                               ;# main widget gets the focus
            $composite::($this,entry,path) configure -state disabled
        }
    } else {
        $widget::($this,path) configure -takefocus 0
        widget::configure $composite::($this,decrease) -state disabled
        widget::configure $composite::($this,increase) -state disabled
        widget::configure $composite::($this,entry) -state disabled
    }
}

proc spinEntry::setupUpAndDownKeysBindings {this path} {
    # handle arrow keys events and make arrow buttons match key movements
    bind $path <KeyPress-Down> "arrowButton::sink $composite::($this,decrease); spinEntry::decrease $this"
    bind $path <KeyRelease-Down> "arrowButton::raise $composite::($this,decrease)"
    bind $path <KeyPress-Up> "arrowButton::sink $composite::($this,increase); spinEntry::increase $this"
    bind $path <KeyRelease-Up> "arrowButton::raise $composite::($this,increase)"
}

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

proc spinEntry::set {this text} {                                                     ;# public procedure for setting entry contents
    ::set path $composite::($this,entry,path)
    $path configure -state normal                                                           ;# entry may not be in an editable state
    $path delete 0 end
    $path insert 0 $text
    if {!$composite::($this,-editable)} {
        $path configure -state disabled                                                            ;# eventually restore entry state
    }
}

proc spinEntry::get {this} {                                                       ;# public procedure for retrieving entry contents
    return [$composite::($this,entry,path) get]
}
