mingw/lib/tk8.5/ttk/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 <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*