blob: 389e31bb548be5567e7c35d4a36c4c5c432950d9 (
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
|
#console show
namespace eval ::ix {
variable _
proc spin_resize {w} {
# update
$w config -height [winfo height $w] -width [winfo width $w]
}
proc spin {c w t bg fg font items arrows} {
if {[winfo exists $w.m] != 1} {
variable _
set _($t:p) 0
array set arrow "up \u25b2 dn \u25bc"; array set anchor "up n dn s"
menubutton $w.m -menu $w.m.m -textvariable _($t:t) -relief raised \
-bg $bg -fg $fg -font $font -padx 0 -pady 0
menu $w.m.m -bd 0 -bg $bg -fg $fg; pack $w.m -side left -fill y
if {$arrows == 1} {
foreach i {up dn} {
button $w.$i -padx 0 -pady 0 -text $arrow($i) \
-command "::ix::spinclick $w $t $i" \
-bd 0 -bg $bg -fg $fg -font {Times 6}
pack $w.$i -anchor $anchor($i)
}
}
spin_resize $w
foreach item $items {spinitem $w $t $item}
$w.m.m activate 0; $w.m.m invoke 0
}
}
proc spinitem {w t item} {
variable _
set len [$w.m.m index end];
if {$len ne "none"} {set n [expr $len + 1]} else {set n 0}
$w.m.m add radiobutton -selectcolor green -font {Tahoma 8} -label $item -variable _($t:t) -command "::ix::spinout $w $t $n"
set wider [string length $item]; set wide [$w.m cget -width]
if {$wide < $wider && $wider <= 31 } {
$w.m configure -width $wider
spin_resize $w
}
$w.m.m activate $n
}
proc spinout {w t i} {
set sym [$w.m.m entrycget $i -label]
pd [concat $t.rp _cb $sym \;]
$w.m.m activate $i
}
proc spinclick {w t d} {
variable _
array set shift "up -1 dn 1"
set len [$w.m.m index end];
set pos $_($t:p)
if {$pos != "none"} {
incr pos $shift($d)
if {$pos > $len} {set pos 0}
if {$pos < 0} {set pos $len}
$w.m.m activate $pos
$w.m.m invoke $pos
}
set _($t:p) $pos
}
proc spinclear {w} {
$w.m.m delete 0 end
$w.m configure -width 0
}
}
#> dm frame
#. -bg green -padx 4 -pady 4 -height 40 -width 86 #arrows 1
#. #bg black #fg "#8888ff" #items {} #font {Tahoma 10}
#. @list foreach x [list .#args] {::ix::spinitem .- .| $x}
#. @symbol ::ix::spinitem .- .| {.#1}
#. @float .-.m.m invoke .#1 .: set ::ix::_(.|:p) .#1
#. @clear ::ix::spinclear .-
puts "dm .- .|"
::ix::spin .^ .- .| .#bg .#fg .#font .#items .#arrows
bind .- <Enter> {focus .-}
bind .- <Leave> {focus .^.c}
bind .- <<spin-dn>> {::ix::spinclick .- .| dn}
bind .- <<spin-up>> {::ix::spinclick .- .| up}
event add <<spin-dn>> <Key-space> <Key-Down> <Key-Right>
event add <<spin-up>> <Key-Up> <Key-Left>
foreach el {.- .-.m} {
bind $el <MouseWheel> {if {%D > 0} {::ix::spinclick .- .| up} else {::ix::spinclick .- .| dn}}
bind $el <Button-4> {::ix::spinclick .- .| up}
bind $el <Button-5> {::ix::spinclick .- .| dn}
}
|
