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	global use_ttk NS
21
22	set v_family $a_family
23	set v_size $a_size
24
25	upvar #0 $v_family pv_family
26	upvar #0 $v_size pv_size
27
28	set f_family $pv_family
29	set f_size $pv_size
30
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]"
35
36	${NS}::label $w.header -text $title -font font_uibold -anchor center
37	pack $w.header -side top -fill x
38
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
50
51	${NS}::frame $w.inner
52
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
73
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
85
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
90
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
110
111	if {$all_families eq {}} {
112		set all_families [lsort [font families]]
113	}
114
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
121		}
122		$w_family insert end "$f\n" $sel
123	}
124	$w_family conf -state disabled
125	_update $this
126
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
133	"
134	wm deiconify $w
135	tkwait window $w
136}
137
138method _select {} {
139	upvar #0 $v_family pv_family
140	upvar #0 $v_size pv_size
141
142	set pv_family $f_family
143	set pv_size $f_size
144
145	destroy $w
146}
147
148method _pick_family {x y} {
149	variable all_families
150
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
158	}
159}
160
161method _update {args} {
162	variable all_families
163
164	set i [lsearch -exact $all_families $f_family]
165	if {$i < 0} return
166
167	$w_example tag conf example -font [list $f_family $f_size]
168	$w_family see [expr {$i + 1}].0
169}
170
171}
172