freshlybakedca.ke
Git fork
1# git-gui font chooser
2# Copyright (C) 2007 Shawn Pearce
3
4class choose_font {
5
6field w
7field w_family ; # UI widget of all known family names
8field w_example ; # Example to showcase the chosen font
9
10field f_family ; # Currently chosen family name
11field f_size ; # Currently chosen point size
12
13field v_family ; # Name of global variable for family
14field v_size ; # Name of global variable for size
15
16variable all_families [list] ; # All fonts known to Tk
17
18constructor pick {path title a_family a_size} {
19 variable all_families
20
21 set v_family $a_family
22 set v_size $a_size
23
24 upvar #0 $v_family pv_family
25 upvar #0 $v_size pv_size
26
27 set f_family $pv_family
28 set f_size $pv_size
29
30 make_dialog top w
31 wm withdraw $top
32 wm title $top "[appname] ([reponame]): $title"
33 wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]"
34
35 ttk::label $w.header -text $title -font font_uibold -anchor center
36 pack $w.header -side top -fill x
37
38 ttk::frame $w.buttons
39 ttk::button $w.buttons.select \
40 -text [mc Select] \
41 -default active \
42 -command [cb _select]
43 ttk::button $w.buttons.cancel \
44 -text [mc Cancel] \
45 -command [list destroy $w]
46 pack $w.buttons.select -side right
47 pack $w.buttons.cancel -side right -padx 5
48 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
49
50 ttk::frame $w.inner
51
52 ttk::frame $w.inner.family
53 ttk::label $w.inner.family.l \
54 -text [mc "Font Family"] \
55 -anchor w
56 set w_family $w.inner.family.v
57 text $w_family \
58 -background white \
59 -foreground black \
60 -borderwidth 1 \
61 -relief sunken \
62 -cursor $::cursor_ptr \
63 -wrap none \
64 -width 30 \
65 -height 10 \
66 -yscrollcommand [list $w.inner.family.sby set]
67 rmsel_tag $w_family
68 ttk::scrollbar $w.inner.family.sby -command [list $w_family yview]
69 pack $w.inner.family.l -side top -fill x
70 pack $w.inner.family.sby -side right -fill y
71 pack $w_family -fill both -expand 1
72
73 ttk::frame $w.inner.size
74 ttk::label $w.inner.size.l \
75 -text [mc "Font Size"] \
76 -anchor w
77 tspinbox $w.inner.size.v \
78 -textvariable @f_size \
79 -from 2 -to 80 -increment 1 \
80 -width 3
81 bind $w.inner.size.v <FocusIn> {%W selection range 0 end}
82 pack $w.inner.size.l -fill x -side top
83 pack $w.inner.size.v -fill x -padx 2
84
85 grid configure $w.inner.family $w.inner.size -sticky nsew
86 grid rowconfigure $w.inner 0 -weight 1
87 grid columnconfigure $w.inner 0 -weight 1
88 pack $w.inner -fill both -expand 1 -padx 5 -pady 5
89
90 ttk::frame $w.example
91 ttk::label $w.example.l \
92 -text [mc "Font Example"] \
93 -anchor w
94 set w_example $w.example.t
95 text $w_example \
96 -background white \
97 -foreground black \
98 -borderwidth 1 \
99 -relief sunken \
100 -height 3 \
101 -width 40
102 rmsel_tag $w_example
103 $w_example tag conf example -justify center
104 $w_example insert end [mc "This is example text.\nIf you like this text, it can be your font."] example
105 $w_example conf -state disabled
106 pack $w.example.l -fill x
107 pack $w_example -fill x
108 pack $w.example -fill x -padx 5
109
110 if {$all_families eq {}} {
111 set all_families [lsort [font families]]
112 }
113
114 $w_family tag conf pick
115 $w_family tag bind pick <Button-1> [cb _pick_family %x %y]\;break
116 foreach f $all_families {
117 set sel [list pick]
118 if {$f eq $f_family} {
119 lappend sel in_sel
120 }
121 $w_family insert end "$f\n" $sel
122 }
123 $w_family conf -state disabled
124 _update $this
125
126 trace add variable @f_size write [cb _update]
127 bind $w <Key-Escape> [list destroy $w]
128 bind $w <Key-Return> [cb _select]\;break
129 bind $w <Visibility> "
130 grab $w
131 focus $w
132 "
133 wm deiconify $w
134 tkwait window $w
135}
136
137method _select {} {
138 upvar #0 $v_family pv_family
139 upvar #0 $v_size pv_size
140
141 set pv_family $f_family
142 set pv_size $f_size
143
144 destroy $w
145}
146
147method _pick_family {x y} {
148 variable all_families
149
150 set i [lindex [split [$w_family index @$x,$y] .] 0]
151 set n [lindex $all_families [expr {$i - 1}]]
152 if {$n ne {}} {
153 $w_family tag remove in_sel 0.0 end
154 $w_family tag add in_sel $i.0 [expr {$i + 1}].0
155 set f_family $n
156 _update $this
157 }
158}
159
160method _update {args} {
161 variable all_families
162
163 set i [lsearch -exact $all_families $f_family]
164 if {$i < 0} return
165
166 $w_example tag conf example -font [list $f_family $f_size]
167 $w_family see [expr {$i + 1}].0
168}
169
170}