| 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 | |
| 21 | set v_family $a_family |
| 22 | set v_size $a_size |
| 23 | |
| 24 | upvar #0 $v_family pv_family |
| 25 | upvar #0 $v_size pv_size |
| 26 | |
| 27 | set f_family $pv_family |
| 28 | set f_size $pv_size |
| 29 | |
| 30 | make_dialog top w |
| 31 | wm withdraw $top |
| 32 | wm title $top "[appname] ([reponame]): $title" |
| 33 | wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]" |
| 34 | |
| 35 | ttk::label $w.header -text $title -font font_uibold -anchor center |
| 36 | pack $w.header -side top -fill x |
| 37 | |
| 38 | ttk::frame $w.buttons |
| 39 | ttk::button $w.buttons.select \ |
| 40 | -text [mc Select] \ |
| 41 | -default active \ |
| 42 | -command [cb _select] |
| 43 | ttk::button $w.buttons.cancel \ |
| 44 | -text [mc Cancel] \ |
| 45 | -command [list destroy $w] |
| 46 | pack $w.buttons.select -side right |
| 47 | pack $w.buttons.cancel -side right -padx 5 |
| 48 | pack $w.buttons -side bottom -fill x -pady 10 -padx 10 |
| 49 | |
| 50 | ttk::frame $w.inner |
| 51 | |
| 52 | ttk::frame $w.inner.family |
| 53 | ttk::label $w.inner.family.l \ |
| 54 | -text [mc "Font Family"] \ |
| 55 | -anchor w |
| 56 | set w_family $w.inner.family.v |
| 57 | text $w_family \ |
| 58 | -background white \ |
| 59 | -foreground black \ |
| 60 | -borderwidth 1 \ |
| 61 | -relief sunken \ |
| 62 | -cursor $::cursor_ptr \ |
| 63 | -wrap none \ |
| 64 | -width 30 \ |
| 65 | -height 10 \ |
| 66 | -yscrollcommand [list $w.inner.family.sby set] |
| 67 | rmsel_tag $w_family |
| 68 | ttk::scrollbar $w.inner.family.sby -command [list $w_family yview] |
| 69 | pack $w.inner.family.l -side top -fill x |
| 70 | pack $w.inner.family.sby -side right -fill y |
| 71 | pack $w_family -fill both -expand 1 |
| 72 | |
| 73 | ttk::frame $w.inner.size |
| 74 | ttk::label $w.inner.size.l \ |
| 75 | -text [mc "Font Size"] \ |
| 76 | -anchor w |
| 77 | tspinbox $w.inner.size.v \ |
| 78 | -textvariable @f_size \ |
| 79 | -from 2 -to 80 -increment 1 \ |
| 80 | -width 3 |
| 81 | bind $w.inner.size.v <FocusIn> {%W selection range 0 end} |
| 82 | pack $w.inner.size.l -fill x -side top |
| 83 | pack $w.inner.size.v -fill x -padx 2 |
| 84 | |
| 85 | grid configure $w.inner.family $w.inner.size -sticky nsew |
| 86 | grid rowconfigure $w.inner 0 -weight 1 |
| 87 | grid columnconfigure $w.inner 0 -weight 1 |
| 88 | pack $w.inner -fill both -expand 1 -padx 5 -pady 5 |
| 89 | |
| 90 | ttk::frame $w.example |
| 91 | ttk::label $w.example.l \ |
| 92 | -text [mc "Font Example"] \ |
| 93 | -anchor w |
| 94 | set w_example $w.example.t |
| 95 | text $w_example \ |
| 96 | -background white \ |
| 97 | -foreground black \ |
| 98 | -borderwidth 1 \ |
| 99 | -relief sunken \ |
| 100 | -height 3 \ |
| 101 | -width 40 |
| 102 | rmsel_tag $w_example |
| 103 | $w_example tag conf example -justify center |
| 104 | $w_example insert end [mc "This is example text.\nIf you like this text, it can be your font."] example |
| 105 | $w_example conf -state disabled |
| 106 | pack $w.example.l -fill x |
| 107 | pack $w_example -fill x |
| 108 | pack $w.example -fill x -padx 5 |
| 109 | |
| 110 | if {$all_families eq {}} { |
| 111 | set all_families [lsort [font families]] |
| 112 | } |
| 113 | |
| 114 | $w_family tag conf pick |
| 115 | $w_family tag bind pick <Button-1> [cb _pick_family %x %y]\;break |
| 116 | foreach f $all_families { |
| 117 | set sel [list pick] |
| 118 | if {$f eq $f_family} { |
| 119 | lappend sel in_sel |
| 120 | } |
| 121 | $w_family insert end "$f\n" $sel |
| 122 | } |
| 123 | $w_family conf -state disabled |
| 124 | _update $this |
| 125 | |
| 126 | trace add variable @f_size write [cb _update] |
| 127 | bind $w <Key-Escape> [list destroy $w] |
| 128 | bind $w <Key-Return> [cb _select]\;break |
| 129 | bind $w <Visibility> " |
| 130 | grab $w |
| 131 | focus $w |
| 132 | " |
| 133 | wm deiconify $w |
| 134 | tkwait window $w |
| 135 | } |
| 136 | |
| 137 | method _select {} { |
| 138 | upvar #0 $v_family pv_family |
| 139 | upvar #0 $v_size pv_size |
| 140 | |
| 141 | set pv_family $f_family |
| 142 | set pv_size $f_size |
| 143 | |
| 144 | destroy $w |
| 145 | } |
| 146 | |
| 147 | method _pick_family {x y} { |
| 148 | variable all_families |
| 149 | |
| 150 | set i [lindex [split [$w_family index @$x,$y] .] 0] |
| 151 | set n [lindex $all_families [expr {$i - 1}]] |
| 152 | if {$n ne {}} { |
| 153 | $w_family tag remove in_sel 0.0 end |
| 154 | $w_family tag add in_sel $i.0 [expr {$i + 1}].0 |
| 155 | set f_family $n |
| 156 | _update $this |
| 157 | } |
| 158 | } |
| 159 | |
| 160 | method _update {args} { |
| 161 | variable all_families |
| 162 | |
| 163 | set i [lsearch -exact $all_families $f_family] |
| 164 | if {$i < 0} return |
| 165 | |
| 166 | $w_example tag conf example -font [list $f_family $f_size] |
| 167 | $w_family see [expr {$i + 1}].0 |
| 168 | } |
| 169 | |
| 170 | } |