summaryrefslogtreecommitdiffstats
path: root/library/ttk/spinbox.tcl
blob: 9464b072de9520d86b7601258a3ad056ae2e03cf (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
#
# $Id: spinbox.tcl,v 1.2 2008/12/07 18:42:55 jenglish 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>		{ ttk::spinbox::Spin %W +1 }
bind TSpinbox <KeyPress-Down> 		{ ttk::spinbox::Spin %W -1 }

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


# @@@ x-plat
bind TSpinbox <MouseWheel> { ttk::spinbox::Spin %W [expr {%D/-120}] }

## 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
}

proc ttk::spinbox::SelectAll {w} {
    $w selection range 0 end
    $w icursor end
}

proc ttk::spinbox::Limit {v min max} {
    if {$v < $min} { return $min }
    if {$v > $max} { return $max }
    return $v
}

proc ttk::spinbox::Wrap {v min max} {
    if {$v < $min} { return $max }
    if {$v > $max} { return $min }
    return $v
}

proc ttk::spinbox::Adjust {w v min max} {
    if {[$w cget -wrap]} {
	return [Wrap $v $min $max]
    } else  {
	return [Limit $v $min $max]
    }
}

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]
}

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*