spinbox.tcl 4.2 KB

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