"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/ttk/spinbox.tcl" (17 Mar 2020, 4339 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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 {[$w instate disabled]} { return }
   85     if {$dir < 0} {
   86     event generate $w <<Increment>>
   87     } else {
   88     event generate $w <<Decrement>>
   89     }
   90 }
   91 
   92 ## SelectAll --
   93 #   Select widget contents.
   94 #
   95 proc ttk::spinbox::SelectAll {w} {
   96     $w selection range 0 end
   97     $w icursor end
   98 }
   99 
  100 ## Limit --
  101 #   Limit $v to lie between $min and $max
  102 #
  103 proc ttk::spinbox::Limit {v min max} {
  104     if {$v < $min} { return $min }
  105     if {$v > $max} { return $max }
  106     return $v
  107 }
  108 
  109 ## Wrap --
  110 #   Adjust $v to lie between $min and $max, wrapping if out of bounds.
  111 #
  112 proc ttk::spinbox::Wrap {v min max} {
  113     if {$v < $min} { return $max }
  114     if {$v > $max} { return $min }
  115     return $v
  116 }
  117 
  118 ## Adjust --
  119 #   Limit or wrap spinbox value depending on -wrap.
  120 #
  121 proc ttk::spinbox::Adjust {w v min max} {
  122     if {[$w cget -wrap]} {
  123     return [Wrap $v $min $max]
  124     } else  {
  125     return [Limit $v $min $max]
  126     }
  127 }
  128 
  129 ## Spin --
  130 #   Handle <<Increment>> and <<Decrement>> events.
  131 #   If -values is specified, cycle through the list.
  132 #   Otherwise cycle through numeric range based on
  133 #   -from, -to, and -increment.
  134 #
  135 proc ttk::spinbox::Spin {w dir} {
  136     if {[$w instate disabled]} { return }
  137     set nvalues [llength [set values [$w cget -values]]]
  138     set value [$w get]
  139     if {$nvalues} {
  140     set current [lsearch -exact $values $value]
  141     set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
  142     $w set [lindex $values $index]
  143     } else {
  144         if {[catch {
  145             set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
  146     }]} {
  147         set v [$w cget -from]
  148     }
  149     $w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
  150     }
  151     SelectAll $w
  152     uplevel #0 [$w cget -command]
  153 }
  154 
  155 ## FormatValue --
  156 #   Reformat numeric value based on -format.
  157 #
  158 proc ttk::spinbox::FormatValue {w val} {
  159     set fmt [$w cget -format]
  160     if {$fmt eq ""} {
  161     # Try to guess a suitable -format based on -increment.
  162     set delta [expr {abs([$w cget -increment])}]
  163         if {0 < $delta && $delta < 1} {
  164         # NB: This guesses wrong if -increment has more than 1
  165         # significant digit itself, e.g., -increment 0.25
  166         set nsd [expr {int(ceil(-log10($delta)))}]
  167         set fmt "%.${nsd}f"
  168     } else {
  169         set fmt "%.0f"
  170     }
  171     }
  172     return [format $fmt $val]
  173 }
  174 
  175 #*EOF*