spinbox.tcl 4.7 KB

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