spinbox.tcl (4255B)
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 <ButtonPress-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 <KeyPress-Up> { event generate %W <<Increment>> } 21 bind TSpinbox <KeyPress-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 if { [$w identify $x $y] eq "textarea" 33 && [$w instate {!readonly !disabled}] 34 } { 35 ttk::setCursor $w text 36 } else { 37 ttk::setCursor $w "" 38 } 39 } 40 41 ## Press -- 42 # 43 proc ttk::spinbox::Press {w x y} { 44 if {[$w instate disabled]} { return } 45 focus $w 46 switch -glob -- [$w identify $x $y] { 47 *textarea { ttk::entry::Press $w $x } 48 *rightarrow - 49 *uparrow { ttk::Repeatedly event generate $w <<Increment>> } 50 *leftarrow - 51 *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } 52 *spinbutton { 53 if {$y * 2 >= [winfo height $w]} { 54 set event <<Decrement>> 55 } else { 56 set event <<Increment>> 57 } 58 ttk::Repeatedly event generate $w $event 59 } 60 } 61 } 62 63 ## DoubleClick -- 64 # Select all if over the text area; otherwise same as Press. 65 # 66 proc ttk::spinbox::DoubleClick {w x y} { 67 if {[$w instate disabled]} { return } 68 69 switch -glob -- [$w identify $x $y] { 70 *textarea { SelectAll $w } 71 * { Press $w $x $y } 72 } 73 } 74 75 proc ttk::spinbox::Release {w} { 76 ttk::CancelRepeat 77 } 78 79 ## MouseWheel -- 80 # Mousewheel callback. Turn these into <<Increment>> (-1, up) 81 # or <<Decrement> (+1, down) events. 82 # 83 proc ttk::spinbox::MouseWheel {w dir} { 84 if {$dir < 0} { 85 event generate $w <<Increment>> 86 } else { 87 event generate $w <<Decrement>> 88 } 89 } 90 91 ## SelectAll -- 92 # Select widget contents. 93 # 94 proc ttk::spinbox::SelectAll {w} { 95 $w selection range 0 end 96 $w icursor end 97 } 98 99 ## Limit -- 100 # Limit $v to lie between $min and $max 101 # 102 proc ttk::spinbox::Limit {v min max} { 103 if {$v < $min} { return $min } 104 if {$v > $max} { return $max } 105 return $v 106 } 107 108 ## Wrap -- 109 # Adjust $v to lie between $min and $max, wrapping if out of bounds. 110 # 111 proc ttk::spinbox::Wrap {v min max} { 112 if {$v < $min} { return $max } 113 if {$v > $max} { return $min } 114 return $v 115 } 116 117 ## Adjust -- 118 # Limit or wrap spinbox value depending on -wrap. 119 # 120 proc ttk::spinbox::Adjust {w v min max} { 121 if {[$w cget -wrap]} { 122 return [Wrap $v $min $max] 123 } else { 124 return [Limit $v $min $max] 125 } 126 } 127 128 ## Spin -- 129 # Handle <<Increment>> and <<Decrement>> events. 130 # If -values is specified, cycle through the list. 131 # Otherwise cycle through numeric range based on 132 # -from, -to, and -increment. 133 # 134 proc ttk::spinbox::Spin {w dir} { 135 set nvalues [llength [set values [$w cget -values]]] 136 set value [$w get] 137 if {$nvalues} { 138 set current [lsearch -exact $values $value] 139 set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]] 140 $w set [lindex $values $index] 141 } else { 142 if {[catch { 143 set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] 144 }]} { 145 set v [$w cget -from] 146 } 147 $w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]] 148 } 149 SelectAll $w 150 uplevel #0 [$w cget -command] 151 } 152 153 ## FormatValue -- 154 # Reformat numeric value based on -format. 155 # 156 proc ttk::spinbox::FormatValue {w val} { 157 set fmt [$w cget -format] 158 if {$fmt eq ""} { 159 # Try to guess a suitable -format based on -increment. 160 set delta [expr {abs([$w cget -increment])}] 161 if {0 < $delta && $delta < 1} { 162 # NB: This guesses wrong if -increment has more than 1 163 # significant digit itself, e.g., -increment 0.25 164 set nsd [expr {int(ceil(-log10($delta)))}] 165 set fmt "%.${nsd}f" 166 } else { 167 set fmt "%.0f" 168 } 169 } 170 return [format $fmt $val] 171 } 172 173 #*EOF*