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