Andrew's git - gitweb.git/blob - git-gui/lib/choose

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