summaryrefslogtreecommitdiffstats
path: root/git-gui/lib/choose_font.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'git-gui/lib/choose_font.tcl')
-rw-r--r--git-gui/lib/choose_font.tcl171
1 files changed, 171 insertions, 0 deletions
diff --git a/git-gui/lib/choose_font.tcl b/git-gui/lib/choose_font.tcl
new file mode 100644
index 0000000..ebe50bd
--- /dev/null
+++ b/git-gui/lib/choose_font.tcl
@@ -0,0 +1,171 @@
+# 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
+}
+
+}