Merge branch 'rs/fmt-merge-msg-leakfix'
[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         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
138 method _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
148 method _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
161 method _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 }