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
} {
22 set v_family
$a_family
25 upvar #0 $v_family pv_family
26 upvar #0 $v_size pv_size
28 set f_family
$pv_family
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
\
44 ${NS
}::button $w.buttons.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
53 ${NS
}::frame $w.inner.family
54 ${NS
}::label $w.inner.family.l
\
55 -text [mc
"Font Family"] \
57 set w_family
$w.inner.family.v
63 -cursor $::cursor_ptr \
67 -yscrollcommand [list $w.inner.family.sby
set]
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"] \
78 tspinbox
$w.inner.size.v
\
79 -textvariable @f_size
\
80 -from 2 -to 80 -increment 1 \
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"] \
95 set w_example
$w.example.t
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 {
119 if {$f eq
$f_family} {
122 $w_family insert end
"$f\n" $sel
124 $w_family conf
-state disabled
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
> "
139 upvar #0 $v_family pv_family
140 upvar #0 $v_size pv_size
142 set pv_family
$f_family
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}]]
154 $w_family tag remove in_sel
0.0 end
155 $w_family tag add in_sel
$i.0 [expr {$i + 1}].0
161 method _update
{args
} {
162 variable all_families
164 set i
[lsearch -exact $all_families $f_family]
167 $w_example tag conf example
-font [list $f_family $f_size]
168 $w_family see
[expr {$i + 1}].0