2 # Copyright (C) 2007 Shawn Pearce
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
} {
21 set v_family
$a_family
24 upvar #0 $v_family pv_family
25 upvar #0 $v_size pv_size
27 set f_family
$pv_family
31 wm title
$top "[appname] ([reponame]): $title"
32 wm geometry
$top "+[winfo rootx $path]+[winfo rooty $path]"
34 label $w.header
-text $title -font font_uibold
35 pack $w.header
-side top
-fill x
38 button $w.buttons.select
\
42 button $w.buttons.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
52 label $w.inner.family.l
\
53 -text [mc
"Font Family"] \
55 set w_family
$w.inner.family.v
60 -cursor $::cursor_ptr \
64 -yscrollcommand [list $w.inner.family.sby
set]
65 scrollbar $w.inner.family.sby
-command [list $w_family yview
]
66 pack $w.inner.family.l
-side top
-fill x
67 pack $w.inner.family.sby
-side right
-fill y
68 pack $w_family -fill both
-expand 1
71 label $w.inner.size.l
\
72 -text [mc
"Font Size"] \
74 spinbox $w.inner.size.v
\
75 -textvariable @f_size
\
76 -from 2 -to 80 -increment 1 \
78 bind $w.inner.size.v
<FocusIn
> {%W
selection range
0 end
}
79 pack $w.inner.size.l
-fill x
-side top
80 pack $w.inner.size.v
-fill x
-padx 2
82 grid configure
$w.inner.family
$w.inner.size
-sticky nsew
83 grid rowconfigure
$w.inner
0 -weight 1
84 grid columnconfigure
$w.inner
0 -weight 1
85 pack $w.inner
-fill both
-expand 1 -padx 5 -pady 5
89 -text [mc
"Font Example"] \
91 set w_example
$w.example.t
98 $w_example tag conf example
-justify center
99 $w_example insert end
[mc
"This is example text.\nIf you like this text, it can be your font."] example
100 $w_example conf
-state disabled
101 pack $w.example.l
-fill x
102 pack $w_example -fill x
103 pack $w.example
-fill x
-padx 5
105 if {$all_families eq
{}} {
106 set all_families
[lsort [font families
]]
109 $w_family tag conf pick
110 $w_family tag
bind pick
<Button-1
> [cb _pick_family
%x
%y
]\;break
111 $w_family tag conf cpck
-background lightgray
112 foreach f
$all_families {
114 if {$f eq
$f_family} {
117 $w_family insert end
"$f\n" $sel
119 $w_family conf
-state disabled
122 trace add
variable @f_size write
[cb _update
]
123 bind $w <Key-Escape
> [list destroy $w]
124 bind $w <Key-Return
> [cb _select
]\;break
125 bind $w <Visibility
> "
133 upvar #0 $v_family pv_family
134 upvar #0 $v_size pv_size
136 set pv_family
$f_family
142 method _pick_family
{x y
} {
143 variable all_families
145 set i
[lindex [split [$w_family index
@$x,$y] .
] 0]
146 set n
[lindex $all_families [expr {$i - 1}]]
148 $w_family tag remove cpck
0.0 end
149 $w_family tag add cpck
$i.0 [expr {$i + 1}].0
155 method _update
{args
} {
156 variable all_families
158 set i
[lsearch -exact $all_families $f_family]
161 $w_example tag conf example
-font [list $f_family $f_size]
162 $w_family see
[expr {$i + 1}].0