diff options
Diffstat (limited to 'library/ttk/spinbox.tcl')
| -rw-r--r-- | library/ttk/spinbox.tcl | 197 |
1 files changed, 110 insertions, 87 deletions
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 579a22c..9464b07 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -1,16 +1,10 @@ # -# $Id: spinbox.tcl,v 1.1 2008/11/01 15:34:24 patthoyts Exp $ +# $Id: spinbox.tcl,v 1.2 2008/12/07 18:42:55 jenglish Exp $ # -# Tile widget set: spinbox bindings. +# ttk::spinbox bindings # -# - -namespace eval ttk::spinbox { - variable Values ;# Values($cb) is -listvariable of listbox widget - variable State - set State(entryPress) 0 -} +namespace eval ttk::spinbox { } ### Spinbox bindings. # @@ -19,103 +13,132 @@ namespace eval ttk::spinbox { ttk::copyBindings TEntry TSpinbox -bind TSpinbox <Double-Button-1> {ttk::spinbox::Select %W %x %y word} -bind TSpinbox <Triple-Button-1> {ttk::spinbox::Select %W %x %y line} +bind TSpinbox <Motion> { ttk::spinbox::Motion %W %x %y } +bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y } +bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W } +bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y } +bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click + +bind TSpinbox <KeyPress-Up> { ttk::spinbox::Spin %W +1 } +bind TSpinbox <KeyPress-Down> { ttk::spinbox::Spin %W -1 } -bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y } -bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W %x %y } -bind TSpinbox <MouseWheel> {ttk::spinbox::Change %W [expr {%D/-120}] line} -bind TSpinbox <Up> {ttk::spinbox::Change %W +[%W cget -increment] line} -bind TSpinbox <Down> {ttk::spinbox::Change %W -[%W cget -increment] line} +bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 } +bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } +# @@@ x-plat +bind TSpinbox <MouseWheel> { ttk::spinbox::Spin %W [expr {%D/-120}] } + +## Motion -- +# Sets cursor. +# +proc ttk::spinbox::Motion {w x y} { + if { [$w identify $x $y] eq "textarea" + && [$w instate {!readonly !disabled}] + } { + ttk::setCursor $w text + } else { + ttk::setCursor $w "" + } +} + +## Press -- +# proc ttk::spinbox::Press {w x y} { if {[$w instate disabled]} { return } - variable State - set State(xPress) $x - set State(yPress) $y focus $w switch -glob -- [$w identify $x $y] { - *uparrow { - ttk::Repeatedly Change $w +[$w cget -increment] line - } - *downarrow { - ttk::Repeatedly Change $w -[$w cget -increment] line - } - *textarea { - set State(entryPress) [$w instate !readonly] - if {$State(entryPress)} { - ttk::entry::Press $w $x - } - } + *textarea { ttk::entry::Press $w $x } + *rightarrow - + *uparrow { ttk::Repeatedly event generate $w <<Increment>> } + *leftarrow - + *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } + *spinbutton { + if {$y * 2 >= [winfo height $w]} { + set event <<Decrement>> + } else { + set event <<Increment>> + } + ttk::Repeatedly event generate $w $event + } } } -proc ttk::spinbox::Release {w x y} { - variable State - unset -nocomplain State(xPress) State(yPress) +## DoubleClick -- +# Select all if over the text area; otherwise same as Press. +# +proc ttk::spinbox::DoubleClick {w x y} { + if {[$w instate disabled]} { return } + + switch -glob -- [$w identify $x $y] { + *textarea { SelectAll $w } + * { Press $w $x $y } + } +} + +proc ttk::spinbox::Release {w} { ttk::CancelRepeat } -proc ttk::spinbox::Change {w n units} { - if {[set vlen [llength [$w cget -values]]] != 0} { - set index [expr {[$w current] + $n}] - if {[catch {$w current $index}]} { - if {[$w cget -wrap]} { - if {$index == -1} { - set index [llength [$w cget -values]] - incr index -1 - } else { - set index 0 - } - $w current $index - } - } - } else { - if {![catch {expr {[$w get] + $n}} v]} { - if {$v < [$w cget -from]} { - if {[$w cget -wrap]} { - set v [$w cget -to] - } else { - set v [$w cget -from] - } - } elseif {$v > [$w cget -to]} { - if {[$w cget -wrap]} { - set v [$w cget -from] - } else { - set v [$w cget -to] - } - } - $w set $v - } +proc ttk::spinbox::SelectAll {w} { + $w selection range 0 end + $w icursor end +} + +proc ttk::spinbox::Limit {v min max} { + if {$v < $min} { return $min } + if {$v > $max} { return $max } + return $v +} + +proc ttk::spinbox::Wrap {v min max} { + if {$v < $min} { return $max } + if {$v > $max} { return $min } + return $v +} + +proc ttk::spinbox::Adjust {w v min max} { + if {[$w cget -wrap]} { + return [Wrap $v $min $max] + } else { + return [Limit $v $min $max] } - ::ttk::entry::Select $w 0 $units +} - # Run -command callback: - # +proc ttk::spinbox::Spin {w dir} { + set nvalues [llength [set values [$w cget -values]]] + set value [$w get] + if {$nvalues} { + set current [lsearch -exact $values $value] + set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]] + $w set [lindex $values $index] + } else { + if {[catch { + set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] + }]} { + set v [$w cget -from] + } + $w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]] + } + SelectAll $w uplevel #0 [$w cget -command] - } -# Spinbox double-click on the arrows needs interception, otherwise -# pass to the TEntry handler -proc ttk::spinbox::Select {w x y mode} { - if {[$w instate disabled]} { return } - variable State - set State(xPress) $x - set State(yPress) $y - switch -glob -- [$w identify $x $y] { - *uparrow { - ttk::Repeatedly Change $w +[$w cget -increment] units - } - *downarrow { - ttk::Repeatedly Change $w -[$w cget -increment] units - } - *textarea { - return [::ttk::entry::Select $w $x $mode] - } +proc ttk::spinbox::FormatValue {w val} { + set fmt [$w cget -format] + if {$fmt eq ""} { + # Try to guess a suitable -format based on -increment. + set delta [expr {abs([$w cget -increment])}] + if {0 < $delta && $delta < 1} { + # NB: This guesses wrong if -increment has more than 1 + # significant digit itself, e.g., -increment 0.25 + set nsd [expr {int(ceil(-log10($delta)))}] + set fmt "%.${nsd}f" + } else { + set fmt "%.0f" + } } - return -code continue + return [format $fmt $val] } #*EOF* |