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