1 # Functions for supporting the use of themed Tk widgets in git-gui.
2 # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
7 # Preffered way to set widget colors is using add_option.
8 # In some cases, like with tags in_diff/in_sel, we use these colors.
9 variable select_bg lightgray
10 variable select_fg black
12 proc sync_with_theme {} {
13 set base_bg [ttk::style lookup . -background]
14 set base_fg [ttk::style lookup . -foreground]
15 set text_bg [ttk::style lookup Treeview -background]
16 set text_fg [ttk::style lookup Treeview -foreground]
17 set select_bg [ttk::style lookup Default -selectbackground]
18 set select_fg [ttk::style lookup Default -selectforeground]
20 set color::select_bg $select_bg
21 set color::select_fg $select_fg
23 proc add_option {key val} {
24 option add $key $val widgetDefault
26 # Add options for plain Tk widgets
27 # Using `option add` instead of tk_setPalette to avoid unintended
30 add_option *Menu.Background $base_bg
31 add_option *Menu.Foreground $base_fg
32 add_option *Menu.activeBackground $select_bg
33 add_option *Menu.activeForeground $select_fg
35 add_option *Text.Background $text_bg
36 add_option *Text.Foreground $text_fg
37 add_option *Text.HighlightBackground $base_bg
38 add_option *Text.HighlightColor $select_bg
42 proc ttk_get_current_theme {} {
43 # Handle either current Tk or older versions of 8.5
44 if {[catch {set theme [ttk::style theme use]}]} {
45 set theme $::ttk::currentTheme
51 # Create a color label style (bg can be overridden by widget option)
52 ttk::style layout Color.TLabel {
53 Color.Label.border -sticky news -children {
54 Color.label.fill -sticky news -children {
55 Color.Label.padding -sticky news -children {
56 Color.Label.label -sticky news}}}}
57 eval [linsert [ttk::style configure TLabel] 0 \
58 ttk::style configure Color.TLabel]
59 ttk::style configure Color.TLabel \
60 -borderwidth 0 -relief flat -padding 2
61 ttk::style map Color.TLabel -background {{} gold}
62 # We also need a padded label.
63 ttk::style configure Padded.TLabel \
64 -padding {5 5} -borderwidth 1 -relief solid
65 # We need a gold frame.
66 ttk::style layout Gold.TFrame {
67 Gold.Frame.border -sticky nswe -children {
68 Gold.Frame.fill -sticky nswe}}
69 ttk::style configure Gold.TFrame -background gold -relief flat
70 # listboxes should have a theme border so embed in ttk::frame
71 ttk::style layout SListbox.TFrame {
72 SListbox.Frame.Entry.field -sticky news -border true -children {
73 SListbox.Frame.padding -sticky news
77 set theme [ttk_get_current_theme]
79 if {[lsearch -exact {default alt classic clam} $theme] != -1} {
80 # Simple override of standard ttk::entry to change the field
81 # packground according to a state flag. We should use 'user1'
82 # but not all versions of 8.5 support that so make use of 'pressed'
83 # which is not normally in use for entry widgets.
84 ttk::style layout Edged.Entry [ttk::style layout TEntry]
85 ttk::style map Edged.Entry {*}[ttk::style map TEntry]
86 ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
87 -fieldbackground lightgreen
88 ttk::style map Edged.Entry -fieldbackground {
89 {pressed !disabled} lightpink
92 # For fancier themes, in particular the Windows ones, the field
93 # element may not support changing the background color. So instead
94 # override the fill using the default fill element. If we overrode
95 # the vista theme field element we would loose the themed border
98 ttk::style element create color.fill from default
101 ttk::style layout Edged.Entry {
102 Edged.Entry.field -sticky nswe -border 0 -children {
103 Edged.Entry.border -sticky nswe -border 1 -children {
104 Edged.Entry.padding -sticky nswe -children {
105 Edged.Entry.color.fill -sticky nswe -children {
106 Edged.Entry.textarea -sticky nswe
113 ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
114 -background lightgreen -padding 0 -borderwidth 0
115 ttk::style map Edged.Entry {*}[ttk::style map TEntry] \
116 -background {{pressed !disabled} lightpink}
119 if {[lsearch [bind . <<ThemeChanged>>] InitTheme] == -1} {
120 bind . <<ThemeChanged>> +[namespace code [list InitTheme]]
124 # Define a style used for the surround of text widgets.
125 proc InitEntryFrame {} {
126 ttk::style theme settings default {
127 ttk::style layout EntryFrame {
128 EntryFrame.field -sticky nswe -border 0 -children {
129 EntryFrame.fill -sticky nswe -children {
130 EntryFrame.padding -sticky nswe
134 ttk::style configure EntryFrame -padding 1 -relief sunken
135 ttk::style map EntryFrame -background {}
137 ttk::style theme settings classic {
138 ttk::style configure EntryFrame -padding 2 -relief sunken
139 ttk::style map EntryFrame -background {}
141 ttk::style theme settings alt {
142 ttk::style configure EntryFrame -padding 2
143 ttk::style map EntryFrame -background {}
145 ttk::style theme settings clam {
146 ttk::style configure EntryFrame -padding 2
147 ttk::style map EntryFrame -background {}
150 # Ignore errors for missing native themes
152 ttk::style theme settings winnative {
153 ttk::style configure EntryFrame -padding 2
155 ttk::style theme settings xpnative {
156 ttk::style configure EntryFrame -padding 1
157 ttk::style element create EntryFrame.field vsapi \
158 EDIT 1 {disabled 4 focus 3 active 2 {} 1} -padding 1
160 ttk::style theme settings vista {
161 ttk::style configure EntryFrame -padding 2
162 ttk::style element create EntryFrame.field vsapi \
163 EDIT 6 {disabled 4 focus 3 active 2 {} 1} -padding 2
167 bind EntryFrame <Enter> {%W instate !disabled {%W state active}}
168 bind EntryFrame <Leave> {%W state !active}
169 bind EntryFrame <<ThemeChanged>> {
170 set pad [ttk::style lookup EntryFrame -padding]
171 %W configure -padding [expr {$pad eq {} ? 1 : $pad}]
175 proc gold_frame {w args} {
178 eval [linsert $args 0 ttk::frame $w -style Gold.TFrame]
180 eval [linsert $args 0 frame $w -background gold]
184 proc tlabel {w args} {
187 set cmd [list ttk::label $w -style Color.TLabel]
188 foreach {k v} $args {
191 default { lappend cmd $k $v }
196 eval [linsert $args 0 label $w]
200 # The padded label gets used in the about class.
201 proc paddedlabel {w args} {
204 eval [linsert $args 0 ttk::label $w -style Padded.TLabel]
206 eval [linsert $args 0 label $w \
215 # Create a toplevel for use as a dialog.
216 # If available, sets the EWMH dialog hint and if ttk is enabled
217 # place a themed frame over the surface.
218 proc Dialog {w args} {
219 eval [linsert $args 0 toplevel $w -class Dialog]
220 catch {wm attributes $w -type dialog}
225 # Tk toplevels are not themed - so pave it over with a themed frame to get
226 # the base color correct per theme.
227 proc pave_toplevel {w} {
229 if {$use_ttk && ![winfo exists $w.!paving]} {
230 set paving [ttk::frame $w.!paving]
231 place $paving -x 0 -y 0 -relwidth 1 -relheight 1
236 # Create a scrolled listbox with appropriate border for the current theme.
237 # On many themes the border for a scrolled listbox needs to go around the
238 # listbox and the scrollbar.
239 proc slistbox {w args} {
242 set f [ttk::frame $w -style SListbox.TFrame -padding 2]
244 set f [frame $w -relief flat]
248 eval [linsert $args 0 listbox $f.list -relief flat \
249 -highlightthickness 0 -borderwidth 0]
251 eval [linsert $args 0 listbox $f.list]
253 ${NS}::scrollbar $f.vs -command [list $f.list yview]
254 $f.list configure -yscrollcommand [list $f.vs set]
255 grid $f.list $f.vs -sticky news
256 grid rowconfigure $f 0 -weight 1
257 grid columnconfigure $f 0 -weight 1
258 bind $f.list <<ListboxSelect>> \
259 [list event generate $w <<ListboxSelect>>]
261 interp alias {} $w {} $f.list
264 return -code error $err
269 # fetch the background color from a widget.
270 proc get_bg_color {w} {
273 set bg [ttk::style lookup [winfo class $w] -background]
275 set bg [$w cget -background]
280 # ttk::spinbox didn't get added until 8.6
281 proc tspinbox {w args} {
283 if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} {
284 eval [linsert $args 0 ttk::spinbox $w]
286 eval [linsert $args 0 spinbox $w]
290 # Create a text widget with any theme specific properties.
291 proc ttext {w args} {
294 switch -- [ttk_get_current_theme] {
295 "vista" - "xpnative" {
296 lappend args -highlightthickness 0 -borderwidth 0
300 set w [eval [linsert $args 0 text $w]]
302 if {[winfo class [winfo parent $w]] eq "EntryFrame"} {
303 bind $w <FocusIn> {[winfo parent %W] state focus}
304 bind $w <FocusOut> {[winfo parent %W] state !focus}
310 # themed frame suitable for surrounding a text field.
311 proc textframe {w args} {
314 if {[catch {ttk::style layout EntryFrame}]} {
317 eval [linsert $args 0 ttk::frame $w -class EntryFrame -style EntryFrame]
319 eval [linsert $args 0 frame $w]
324 proc tentry {w args} {
328 ttk::entry $w -style Edged.Entry
334 interp alias {} $w {} tentry_widgetproc $w
335 eval [linsert $args 0 tentry_widgetproc $w configure]
338 proc tentry_widgetproc {w cmd args} {
343 return [uplevel 1 [list _$w $cmd] $args]
345 if {[lsearch -exact $args pressed] != -1} {
346 _$w configure -background lightpink
348 _$w configure -background lightgreen
354 if {[set n [lsearch -exact $args -background]] != -1} {
355 set args [lreplace $args $n [incr n]]
356 if {[llength $args] == 0} {return}
359 return [uplevel 1 [list _$w $cmd] $args]
361 default { return [uplevel 1 [list _$w $cmd] $args] }
365 # Tk 8.6 provides a standard font selection dialog. This uses the native
366 # dialogs on Windows and MacOSX or a standard Tk dialog on X11.
367 proc tchoosefont {w title familyvar sizevar} {
368 if {[package vsatisfies [package provide Tk] 8.6]} {
369 upvar #0 $familyvar family
370 upvar #0 $sizevar size
371 tk fontchooser configure -parent $w -title $title \
372 -font [list $family $size] \
373 -command [list on_choosefont $familyvar $sizevar]
376 choose_font::pick $w $title $familyvar $sizevar
380 # Called when the Tk 8.6 fontchooser selects a font.
381 proc on_choosefont {familyvar sizevar font} {
382 upvar #0 $familyvar family
383 upvar #0 $sizevar size
384 set font [font actual $font]
385 set family [dict get $font -family]
386 set size [dict get $font -size]
391 # indent-tabs-mode: t