blob: 0c4051b3752b4f88e50e1f4f22189d826234668a (
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
|
# git-gui font chooser
# Copyright (C) 2007 Shawn Pearce
class choose_font {
field w
field w_family ; # UI widget of all known family names
field w_example ; # Example to showcase the chosen font
field f_family ; # Currently chosen family name
field f_size ; # Currently chosen point size
field v_family ; # Name of global variable for family
field v_size ; # Name of global variable for size
variable all_families [list] ; # All fonts known to Tk
constructor pick {path title a_family a_size} {
variable all_families
set v_family $a_family
set v_size $a_size
upvar #0 $v_family pv_family
upvar #0 $v_size pv_size
set f_family $pv_family
set f_size $pv_size
make_toplevel top w
wm title $top "[appname] ([reponame]): $title"
wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]"
label $w.header -text $title -font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
button $w.buttons.select \
-text [mc Select] \
-default active \
-command [cb _select]
button $w.buttons.cancel \
-text [mc Cancel] \
-command [list destroy $w]
pack $w.buttons.select -side right
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
frame $w.inner
frame $w.inner.family
label $w.inner.family.l \
-text [mc "Font Family"] \
-anchor w
set w_family $w.inner.family.v
text $w_family \
-background white \
-borderwidth 1 \
-relief sunken \
-cursor $::cursor_ptr \
-wrap none \
-width 30 \
-height 10 \
-yscrollcommand [list $w.inner.family.sby set]
rmsel_tag $w_family
scrollbar $w.inner.family.sby -command [list $w_family yview]
pack $w.inner.family.l -side top -fill x
pack $w.inner.family.sby -side right -fill y
pack $w_family -fill both -expand 1
frame $w.inner.size
label $w.inner.size.l \
-text [mc "Font Size"] \
-anchor w
spinbox $w.inner.size.v \
-textvariable @f_size \
-from 2 -to 80 -increment 1 \
-width 3
bind $w.inner.size.v <FocusIn> {%W selection range 0 end}
pack $w.inner.size.l -fill x -side top
pack $w.inner.size.v -fill x -padx 2
grid configure $w.inner.family $w.inner.size -sticky nsew
grid rowconfigure $w.inner 0 -weight 1
grid columnconfigure $w.inner 0 -weight 1
pack $w.inner -fill both -expand 1 -padx 5 -pady 5
frame $w.example
label $w.example.l \
-text [mc "Font Example"] \
-anchor w
set w_example $w.example.t
text $w_example \
-background white \
-borderwidth 1 \
-relief sunken \
-height 3 \
-width 40
rmsel_tag $w_example
$w_example tag conf example -justify center
$w_example insert end [mc "This is example text.\nIf you like this text, it can be your font."] example
$w_example conf -state disabled
pack $w.example.l -fill x
pack $w_example -fill x
pack $w.example -fill x -padx 5
if {$all_families eq {}} {
set all_families [lsort [font families]]
}
$w_family tag conf pick
$w_family tag bind pick <Button-1> [cb _pick_family %x %y]\;break
foreach f $all_families {
set sel [list pick]
if {$f eq $f_family} {
lappend sel in_sel
}
$w_family insert end "$f\n" $sel
}
$w_family conf -state disabled
_update $this
trace add variable @f_size write [cb _update]
bind $w <Key-Escape> [list destroy $w]
bind $w <Key-Return> [cb _select]\;break
bind $w <Visibility> "
grab $w
focus $w
"
tkwait window $w
}
method _select {} {
upvar #0 $v_family pv_family
upvar #0 $v_size pv_size
set pv_family $f_family
set pv_size $f_size
destroy $w
}
method _pick_family {x y} {
variable all_families
set i [lindex [split [$w_family index @$x,$y] .] 0]
set n [lindex $all_families [expr {$i - 1}]]
if {$n ne {}} {
$w_family tag remove in_sel 0.0 end
$w_family tag add in_sel $i.0 [expr {$i + 1}].0
set f_family $n
_update $this
}
}
method _update {args} {
variable all_families
set i [lsearch -exact $all_families $f_family]
if {$i < 0} return
$w_example tag conf example -font [list $f_family $f_size]
$w_family see [expr {$i + 1}].0
}
}
|
