spinbox.tcl
1 # 2 # ttk::spinbox bindings 3 # 4 5 namespace eval ttk::spinbox { } 6 7 ### Spinbox bindings. 8 # 9 # Duplicate the Entry bindings, override if needed: 10 # 11 12 ttk::copyBindings TEntry TSpinbox 13 14 bind TSpinbox <Motion> { ttk::spinbox::Motion %W %x %y } 15 bind TSpinbox <Button-1> { ttk::spinbox::Press %W %x %y } 16 bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W } 17 bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y } 18 bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click 19 20 bind TSpinbox <Up> { event generate %W <<Increment>> } 21 bind TSpinbox <Down> { event generate %W <<Decrement>> } 22 23 bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 } 24 bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } 25 26 ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W] 27 28 ## Motion -- 29 # Sets cursor. 30 # 31 proc ttk::spinbox::Motion {w x y} { 32 variable State 33 ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] 34 if { [$w identify $x $y] eq "textarea" 35 && [$w instate {!readonly !disabled}] 36 } { 37 ttk::setCursor $w text 38 } else { 39 ttk::setCursor $w $State(userConfCursor) 40 } 41 } 42 43 ## Press -- 44 # 45 proc ttk::spinbox::Press {w x y} { 46 if {[$w instate disabled]} { return } 47 focus $w 48 switch -glob -- [$w identify $x $y] { 49 *textarea { ttk::entry::Press $w $x } 50 *rightarrow - 51 *uparrow { ttk::Repeatedly event generate $w <<Increment>> } 52 *leftarrow - 53 *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } 54 *spinbutton { 55 if {$y * 2 >= [winfo height $w]} { 56 set event <<Decrement>> 57 } else { 58 set event <<Increment>> 59 } 60 ttk::Repeatedly event generate $w $event 61 } 62 } 63 } 64 65 ## DoubleClick -- 66 # Select all if over the text area; otherwise same as Press. 67 # 68 proc ttk::spinbox::DoubleClick {w x y} { 69 if {[$w instate disabled]} { return } 70 71 switch -glob -- [$w identify $x $y] { 72 *textarea { SelectAll $w } 73 * { Press $w $x $y } 74 } 75 } 76 77 proc ttk::spinbox::Release {w} { 78 ttk::CancelRepeat 79 } 80 81 ## MouseWheel -- 82 # Mousewheel callback. Turn these into <<Increment>> (-1, up) 83 # or <<Decrement> (+1, down) events. 84 # 85 proc ttk::spinbox::MouseWheel {w dir} { 86 if {[$w instate disabled]} { return } 87 if {$dir < 0} { 88 event generate $w <<Increment>> 89 } else { 90 event generate $w <<Decrement>> 91 } 92 } 93 94 ## SelectAll -- 95 # Select widget contents. 96 # 97 proc ttk::spinbox::SelectAll {w} { 98 $w selection range 0 end 99 $w icursor end 100 } 101 102 ## Limit -- 103 # Limit $v to lie between $min and $max 104 # 105 proc ttk::spinbox::Limit {v min max} { 106 if {$v < $min} { return $min } 107 if {$v > $max} { return $max } 108 return $v 109 } 110 111 ## Wrap -- 112 # Adjust $v to lie between $min and $max, wrapping if out of bounds. 113 # 114 proc ttk::spinbox::Wrap {v min max} { 115 if {$v < $min} { return $max } 116 if {$v > $max} { return $min } 117 return $v 118 } 119 120 ## Adjust -- 121 # Limit or wrap spinbox value depending on -wrap. 122 # 123 proc ttk::spinbox::Adjust {w v min max} { 124 if {[$w cget -wrap]} { 125 return [Wrap $v $min $max] 126 } else { 127 return [Limit $v $min $max] 128 } 129 } 130 131 ## Spin -- 132 # Handle <<Increment>> and <<Decrement>> events. 133 # If -values is specified, cycle through the list. 134 # Otherwise cycle through numeric range based on 135 # -from, -to, and -increment. 136 # 137 proc ttk::spinbox::Spin {w dir} { 138 variable State 139 140 if {[$w instate disabled]} { return } 141 142 if {![info exists State($w,values.length)]} { 143 set State($w,values.index) -1 144 set State($w,values.last) {} 145 } 146 set State($w,values) [$w cget -values] 147 set State($w,values.length) [llength $State($w,values)] 148 149 if {$State($w,values.length) > 0} { 150 set value [$w get] 151 set current $State($w,values.index) 152 if {$value ne $State($w,values.last)} { 153 set current [lsearch -exact $State($w,values) $value] 154 if {$current < 0} {set current -1} 155 } 156 set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \ 157 [expr {$State($w,values.length) - 1}]] 158 set State($w,values.last) [lindex $State($w,values) $State($w,values.index)] 159 $w set $State($w,values.last) 160 } else { 161 if {[catch { 162 set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] 163 }]} { 164 set v [$w cget -from] 165 } 166 $w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]] 167 } 168 SelectAll $w 169 uplevel #0 [$w cget -command] 170 } 171 172 ## FormatValue -- 173 # Reformat numeric value based on -format. 174 # 175 proc ttk::spinbox::FormatValue {w val} { 176 set fmt [$w cget -format] 177 if {$fmt eq ""} { 178 # Try to guess a suitable -format based on -increment. 179 set delta [expr {abs([$w cget -increment])}] 180 if {0 < $delta && $delta < 1} { 181 # NB: This guesses wrong if -increment has more than 1 182 # significant digit itself, e.g., -increment 0.25 183 set nsd [expr {int(ceil(-log10($delta)))}] 184 set fmt "%.${nsd}f" 185 } else { 186 set fmt "%.0f" 187 } 188 } 189 return [format $fmt $val] 190 } 191 192 #*EOF*