git.oblomov.eu Git - git/blob - git-gui/lib/choose_font.tcl

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