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