This repository has been archived on 2023-03-25. You can view files and clone it, but cannot push or open issues or pull requests.
mightyscape-1.1-deprecated/extensions/inkstitch/bin/tk/ttk/spinbox.tcl
2020-07-30 01:16:18 +02:00

174 lines
4.2 KiB
Tcl

#
# ttk::spinbox bindings
#
namespace eval ttk::spinbox { }
### Spinbox bindings.
#
# Duplicate the Entry bindings, override if needed:
#
ttk::copyBindings TEntry TSpinbox
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> { event generate %W <<Increment>> }
bind TSpinbox <KeyPress-Down> { event generate %W <<Decrement>> }
bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 }
bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 }
ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W]
## 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 }
focus $w
switch -glob -- [$w identify $x $y] {
*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
}
}
}
## 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
}
## MouseWheel --
# Mousewheel callback. Turn these into <<Increment>> (-1, up)
# or <<Decrement> (+1, down) events.
#
proc ttk::spinbox::MouseWheel {w dir} {
if {$dir < 0} {
event generate $w <<Increment>>
} else {
event generate $w <<Decrement>>
}
}
## SelectAll --
# Select widget contents.
#
proc ttk::spinbox::SelectAll {w} {
$w selection range 0 end
$w icursor end
}
## Limit --
# Limit $v to lie between $min and $max
#
proc ttk::spinbox::Limit {v min max} {
if {$v < $min} { return $min }
if {$v > $max} { return $max }
return $v
}
## Wrap --
# Adjust $v to lie between $min and $max, wrapping if out of bounds.
#
proc ttk::spinbox::Wrap {v min max} {
if {$v < $min} { return $max }
if {$v > $max} { return $min }
return $v
}
## Adjust --
# Limit or wrap spinbox value depending on -wrap.
#
proc ttk::spinbox::Adjust {w v min max} {
if {[$w cget -wrap]} {
return [Wrap $v $min $max]
} else {
return [Limit $v $min $max]
}
}
## Spin --
# Handle <<Increment>> and <<Decrement>> events.
# If -values is specified, cycle through the list.
# Otherwise cycle through numeric range based on
# -from, -to, and -increment.
#
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]
}
## FormatValue --
# Reformat numeric value based on -format.
#
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 [format $fmt $val]
}
#*EOF*