# git-gui font chooser # Copyright (C) 2007 Shawn Pearce class choose_font { field w field w_family ; # UI widget of all known family names field w_example ; # Example to showcase the chosen font field f_family ; # Currently chosen family name field f_size ; # Currently chosen point size field v_family ; # Name of global variable for family field v_size ; # Name of global variable for size variable all_families [list] ; # All fonts known to Tk constructor pick {path title a_family a_size} { variable all_families global use_ttk NS set v_family $a_family set v_size $a_size upvar #0 $v_family pv_family upvar #0 $v_size pv_size set f_family $pv_family set f_size $pv_size make_dialog top w wm withdraw $top wm title $top "[appname] ([reponame]): $title" wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]" ${NS}::label $w.header -text $title -font font_uibold -anchor center pack $w.header -side top -fill x ${NS}::frame $w.buttons ${NS}::button $w.buttons.select \ -text [mc Select] \ -default active \ -command [cb _select] ${NS}::button $w.buttons.cancel \ -text [mc Cancel] \ -command [list destroy $w] pack $w.buttons.select -side right pack $w.buttons.cancel -side right -padx 5 pack $w.buttons -side bottom -fill x -pady 10 -padx 10 ${NS}::frame $w.inner ${NS}::frame $w.inner.family ${NS}::label $w.inner.family.l \ -text [mc "Font Family"] \ -anchor w set w_family $w.inner.family.v text $w_family \ -background white \ -foreground black \ -borderwidth 1 \ -relief sunken \ -cursor $::cursor_ptr \ -wrap none \ -width 30 \ -height 10 \ -yscrollcommand [list $w.inner.family.sby set] rmsel_tag $w_family ${NS}::scrollbar $w.inner.family.sby -command [list $w_family yview] pack $w.inner.family.l -side top -fill x pack $w.inner.family.sby -side right -fill y pack $w_family -fill both -expand 1 ${NS}::frame $w.inner.size ${NS}::label $w.inner.size.l \ -text [mc "Font Size"] \ -anchor w tspinbox $w.inner.size.v \ -textvariable @f_size \ -from 2 -to 80 -increment 1 \ -width 3 bind $w.inner.size.v <FocusIn> {%W selection range 0 end} pack $w.inner.size.l -fill x -side top pack $w.inner.size.v -fill x -padx 2 grid configure $w.inner.family $w.inner.size -sticky nsew grid rowconfigure $w.inner 0 -weight 1 grid columnconfigure $w.inner 0 -weight 1 pack $w.inner -fill both -expand 1 -padx 5 -pady 5 ${NS}::frame $w.example ${NS}::label $w.example.l \ -text [mc "Font Example"] \ -anchor w set w_example $w.example.t text $w_example \ -background white \ -foreground black \ -borderwidth 1 \ -relief sunken \ -height 3 \ -width 40 rmsel_tag $w_example $w_example tag conf example -justify center $w_example insert end [mc "This is example text.\nIf you like this text, it can be your font."] example $w_example conf -state disabled pack $w.example.l -fill x pack $w_example -fill x pack $w.example -fill x -padx 5 if {$all_families eq {}} { set all_families [lsort [font families]] } $w_family tag conf pick $w_family tag bind pick <Button-1> [cb _pick_family %x %y]\;break foreach f $all_families { set sel [list pick] if {$f eq $f_family} { lappend sel in_sel } $w_family insert end "$f\n" $sel } $w_family conf -state disabled _update $this trace add variable @f_size write [cb _update] bind $w <Key-Escape> [list destroy $w] bind $w <Key-Return> [cb _select]\;break bind $w <Visibility> " grab $w focus $w " wm deiconify $w tkwait window $w } method _select {} { upvar #0 $v_family pv_family upvar #0 $v_size pv_size set pv_family $f_family set pv_size $f_size destroy $w } method _pick_family {x y} { variable all_families set i [lindex [split [$w_family index @$x,$y] .] 0] set n [lindex $all_families [expr {$i - 1}]] if {$n ne {}} { $w_family tag remove in_sel 0.0 end $w_family tag add in_sel $i.0 [expr {$i + 1}].0 set f_family $n _update $this } } method _update {args} { variable all_families set i [lsearch -exact $all_families $f_family] if {$i < 0} return $w_example tag conf example -font [list $f_family $f_size] $w_family see [expr {$i + 1}].0 } }