summaryrefslogtreecommitdiffstats
path: root/library/ttk/spinbox.tcl
blob: a717379e2c573ccaaa79d0e077f45d977db8f404 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#
# $Id: spinbox.tcl,v 1.3.2.2 2010/08/26 02:06:10 hobbs Exp $
#
# ttk::spinbox bindings
#

namespace eval ttk::spinbox { }

### Spinbox bindings.
#
# Duplicate the Entry bindings, override if needed:
#

ttk::copyBindings TEntry TSpinbox

bind TSpinbox <Motion>			{ ttk::spinbox::Motion %W %x %y }
bind TSpinbox <ButtonPress-1> 		{ ttk::spinbox::Press %W %x %y }
bind TSpinbox <ButtonRelease-1> 	{ ttk::spinbox::Release %W }
bind TSpinbox <Double-Button-1> 	{ ttk::spinbox::DoubleClick %W %x %y }
bind TSpinbox <Triple-Button-1> 	{} ;# disable TEntry triple-click

bind TSpinbox <KeyPress-Up>		{ event generate %W <<Increment>> }
bind TSpinbox <KeyPress-Down> 		{ event generate %W <<Decrement>> }

bind TSpinbox <<Increment>>		{ ttk::spinbox::Spin %W +1 }
bind TSpinbox <<Decrement>> 		{ ttk::spinbox::Spin %W -1 }

ttk::bindMouseWheel TSpinbox 		[list ttk::spinbox::MouseWheel %W]

## Motion --
#	Sets cursor.
#
proc ttk::spinbox::Motion {w x y} {
    if {   [$w identify $x $y] eq "textarea"
        && [$w instate {!readonly !disabled}]
    } {
	ttk::setCursor $w text
    } else {
	ttk::setCursor $w ""
    }
}

## Press --
#
proc ttk::spinbox::Press {w x y} {
    if {[$w instate disabled]} { return }
    focus $w
    switch -glob -- [$w identify $x $y] {
        *textarea	{ ttk::entry::Press $w $x }
	*rightarrow	-
        *uparrow 	{ ttk::Repeatedly event generate $w <<Increment>> }
	*leftarrow	-
        *downarrow	{ ttk::Repeatedly event generate $w <<Decrement>> }
	*spinbutton {
	    if {$y * 2 >= [winfo height $w]} {
	    	set event <<Decrement>>
	    } else {
	    	set event <<Increment>>
	    }
	    ttk::Repeatedly event generate $w $event
	}
    }
}

## DoubleClick --
#	Select all if over the text area; otherwise same as Press.
#
proc ttk::spinbox::DoubleClick {w x y} {
    if {[$w instate disabled]} { return }

    switch -glob -- [$w identify $x $y] {
        *textarea	{ SelectAll $w }
	*		{ Press $w $x $y }
    }
}

proc ttk::spinbox::Release {w} {
    ttk::CancelRepeat
}

## MouseWheel --
#	Mousewheel callback.  Turn these into <<Increment>> (-1, up)
# 	or <<Decrement> (+1, down) events.
#
proc ttk::spinbox::MouseWheel {w dir} {
    if {$dir < 0} {
	event generate $w <<Increment>>
    } else {
	event generate $w <<Decrement>>
    }
}

## SelectAll --
#	Select widget contents.
#
proc ttk::spinbox::SelectAll {w} {
    $w selection range 0 end
    $w icursor end
}

## Limit --
#	Limit $v to lie between $min and $max
#
proc ttk::spinbox::Limit {v min max} {
    if {$v < $min} { return $min }
    if {$v > $max} { return $max }
    return $v
}

## Wrap --
#	Adjust $v to lie between $min and $max, wrapping if out of bounds.
#
proc ttk::spinbox::Wrap {v min max} {
    if {$v < $min} { return $max }
    if {$v > $max} { return $min }
    return $v
}

## Adjust --
#	Limit or wrap spinbox value depending on -wrap.
#
proc ttk::spinbox::Adjust {w v min max} {
    if {[$w cget -wrap]} {
	return [Wrap $v $min $max]
    } else  {
	return [Limit $v $min $max]
    }
}

## Spin --
#	Handle <<Increment>> and <<Decrement>> events.
#	If -values is specified, cycle through the list.
#	Otherwise cycle through numeric range based on
#	-from, -to, and -increment.
#
proc ttk::spinbox::Spin {w dir} {
    set nvalues [llength [set values [$w cget -values]]]
    set value [$w get]
    if {$nvalues} {
	set current [lsearch -exact $values $value]
	set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
	$w set [lindex $values $index]
    } else {
        if {[catch {
    	    set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
	}]} {
	    set v [$w cget -from]
	}
	$w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
    }
    SelectAll $w
    uplevel #0 [$w cget -command]
}

## FormatValue --
#	Reformat numeric value based on -format.
#
proc ttk::spinbox::FormatValue {w val} {
    set fmt [$w cget -format]
    if {$fmt eq ""} {
	# Try to guess a suitable -format based on -increment.
	set delta [expr {abs([$w cget -increment])}]
        if {0 < $delta && $delta < 1} {
	    # NB: This guesses wrong if -increment has more than 1
	    # significant digit itself, e.g., -increment 0.25
	    set nsd [expr {int(ceil(-log10($delta)))}]
	    set fmt "%.${nsd}f"
	} else {
	    set fmt "%.0f"
	}
    }
    return [format $fmt $val]
}

#*EOF*