Merge branch 'tg/stash-untracked-with-pathspec-fix'
[git] / git-gui / lib / themed.tcl
1 # Functions for supporting the use of themed Tk widgets in git-gui.
2 # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
3
4 proc InitTheme {} {
5         # Create a color label style (bg can be overridden by widget option)
6         ttk::style layout Color.TLabel {
7                 Color.Label.border -sticky news -children {
8                         Color.label.fill -sticky news -children {
9                                 Color.Label.padding -sticky news -children {
10                                         Color.Label.label -sticky news}}}}
11         eval [linsert [ttk::style configure TLabel] 0 \
12                           ttk::style configure Color.TLabel]
13         ttk::style configure Color.TLabel \
14                 -borderwidth 0 -relief flat -padding 2
15         ttk::style map Color.TLabel -background {{} gold}
16         # We also need a padded label.
17         ttk::style configure Padded.TLabel \
18                 -padding {5 5} -borderwidth 1 -relief solid
19         # We need a gold frame.
20         ttk::style layout Gold.TFrame {
21                 Gold.Frame.border -sticky nswe -children {
22                         Gold.Frame.fill -sticky nswe}}
23         ttk::style configure Gold.TFrame -background gold -relief flat
24         # listboxes should have a theme border so embed in ttk::frame
25         ttk::style layout SListbox.TFrame {
26                 SListbox.Frame.Entry.field -sticky news -border true -children {
27                         SListbox.Frame.padding -sticky news
28                 }
29         }
30
31         # Handle either current Tk or older versions of 8.5
32         if {[catch {set theme [ttk::style theme use]}]} {
33                 set theme  $::ttk::currentTheme
34         }
35
36         if {[lsearch -exact {default alt classic clam} $theme] != -1} {
37                 # Simple override of standard ttk::entry to change the field
38                 # packground according to a state flag. We should use 'user1'
39                 # but not all versions of 8.5 support that so make use of 'pressed'
40                 # which is not normally in use for entry widgets.
41                 ttk::style layout Edged.Entry [ttk::style layout TEntry]
42                 ttk::style map Edged.Entry {*}[ttk::style map TEntry]
43                 ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
44                         -fieldbackground lightgreen
45                 ttk::style map Edged.Entry -fieldbackground {
46                         {pressed !disabled} lightpink
47                 }
48         } else {
49                 # For fancier themes, in particular the Windows ones, the field
50                 # element may not support changing the background color. So instead
51                 # override the fill using the default fill element. If we overrode
52                 # the vista theme field element we would loose the themed border
53                 # of the widget.
54                 catch {
55                         ttk::style element create color.fill from default
56                 }
57
58                 ttk::style layout Edged.Entry {
59                         Edged.Entry.field -sticky nswe -border 0 -children {
60                                 Edged.Entry.border -sticky nswe -border 1 -children {
61                                         Edged.Entry.padding -sticky nswe -children {
62                                                 Edged.Entry.color.fill -sticky nswe -children {
63                                                         Edged.Entry.textarea -sticky nswe
64                                                 }
65                                         }
66                                 }
67                         }
68                 }
69
70                 ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
71                         -background lightgreen -padding 0 -borderwidth 0
72                 ttk::style map Edged.Entry {*}[ttk::style map TEntry] \
73                         -background {{pressed !disabled} lightpink}
74         }
75
76         if {[lsearch [bind . <<ThemeChanged>>] InitTheme] == -1} {
77                 bind . <<ThemeChanged>> +[namespace code [list InitTheme]]
78         }
79 }
80
81 # Define a style used for the surround of text widgets.
82 proc InitEntryFrame {} {
83         ttk::style theme settings default {
84                 ttk::style layout EntryFrame {
85                         EntryFrame.field -sticky nswe -border 0 -children {
86                                 EntryFrame.fill -sticky nswe -children {
87                                         EntryFrame.padding -sticky nswe
88                                 }
89                         }
90                 }
91                 ttk::style configure EntryFrame -padding 1 -relief sunken
92                 ttk::style map EntryFrame -background {}
93         }
94         ttk::style theme settings classic {
95                 ttk::style configure EntryFrame -padding 2 -relief sunken
96                 ttk::style map EntryFrame -background {}
97         }
98         ttk::style theme settings alt {
99                 ttk::style configure EntryFrame -padding 2
100                 ttk::style map EntryFrame -background {}
101         }
102         ttk::style theme settings clam {
103                 ttk::style configure EntryFrame -padding 2
104                 ttk::style map EntryFrame -background {}
105         }
106
107         # Ignore errors for missing native themes
108         catch {
109                 ttk::style theme settings winnative {
110                         ttk::style configure EntryFrame -padding 2
111                 }
112                 ttk::style theme settings xpnative {
113                         ttk::style configure EntryFrame -padding 1
114                         ttk::style element create EntryFrame.field vsapi \
115                                 EDIT 1 {disabled 4 focus 3 active 2 {} 1} -padding 1
116                 }
117                 ttk::style theme settings vista {
118                         ttk::style configure EntryFrame -padding 2
119                         ttk::style element create EntryFrame.field vsapi \
120                                 EDIT 6 {disabled 4 focus 3 active 2 {} 1} -padding 2
121                 }
122         }
123
124         bind EntryFrame <Enter> {%W instate !disabled {%W state active}}
125         bind EntryFrame <Leave> {%W state !active}
126         bind EntryFrame <<ThemeChanged>> {
127                 set pad [ttk::style lookup EntryFrame -padding]
128                 %W configure -padding [expr {$pad eq {} ? 1 : $pad}]
129         }
130 }
131
132 proc gold_frame {w args} {
133         global use_ttk
134         if {$use_ttk} {
135                 eval [linsert $args 0 ttk::frame $w -style Gold.TFrame]
136         } else {
137                 eval [linsert $args 0 frame $w -background gold]
138         }
139 }
140
141 proc tlabel {w args} {
142         global use_ttk
143         if {$use_ttk} {
144                 set cmd [list ttk::label $w -style Color.TLabel]
145                 foreach {k v} $args {
146                         switch -glob -- $k {
147                                 -activebackground {}
148                                 default { lappend cmd $k $v }
149                         }
150                 }
151                 eval $cmd
152         } else {
153                 eval [linsert $args 0 label $w]
154         }
155 }
156
157 # The padded label gets used in the about class.
158 proc paddedlabel {w args} {
159         global use_ttk
160         if {$use_ttk} {
161                 eval [linsert $args 0 ttk::label $w -style Padded.TLabel]
162         } else {
163                 eval [linsert $args 0 label $w \
164                                   -padx 5 -pady 5 \
165                                   -justify left \
166                                   -anchor w \
167                                   -borderwidth 1 \
168                                   -relief solid]
169         }
170 }
171
172 # Create a toplevel for use as a dialog.
173 # If available, sets the EWMH dialog hint and if ttk is enabled
174 # place a themed frame over the surface.
175 proc Dialog {w args} {
176         eval [linsert $args 0 toplevel $w -class Dialog]
177         catch {wm attributes $w -type dialog}
178         pave_toplevel $w
179         return $w
180 }
181
182 # Tk toplevels are not themed - so pave it over with a themed frame to get
183 # the base color correct per theme.
184 proc pave_toplevel {w} {
185         global use_ttk
186         if {$use_ttk && ![winfo exists $w.!paving]} {
187                 set paving [ttk::frame $w.!paving]
188                 place $paving -x 0 -y 0 -relwidth 1 -relheight 1
189                 lower $paving
190         }
191 }
192
193 # Create a scrolled listbox with appropriate border for the current theme.
194 # On many themes the border for a scrolled listbox needs to go around the
195 # listbox and the scrollbar.
196 proc slistbox {w args} {
197         global use_ttk NS
198         if {$use_ttk} {
199                 set f [ttk::frame $w -style SListbox.TFrame -padding 2]
200         } else {
201                 set f [frame $w -relief flat]
202         }
203     if {[catch {
204                 if {$use_ttk} {
205                         eval [linsert $args 0 listbox $f.list -relief flat \
206                                           -highlightthickness 0 -borderwidth 0]
207                 } else {
208                         eval [linsert $args 0 listbox $f.list]
209                 }
210         ${NS}::scrollbar $f.vs -command [list $f.list yview]
211         $f.list configure -yscrollcommand [list $f.vs set]
212         grid $f.list $f.vs -sticky news
213         grid rowconfigure $f 0 -weight 1
214         grid columnconfigure $f 0 -weight 1
215                 bind $f.list <<ListboxSelect>> \
216                         [list event generate $w <<ListboxSelect>>]
217         interp hide {} $w
218         interp alias {} $w {} $f.list
219     } err]} {
220         destroy $f
221         return -code error $err
222     }
223     return $w
224 }
225
226 # fetch the background color from a widget.
227 proc get_bg_color {w} {
228         global use_ttk
229         if {$use_ttk} {
230                 set bg [ttk::style lookup [winfo class $w] -background]
231         } else {
232                 set bg [$w cget -background]
233         }
234         return $bg
235 }
236
237 # ttk::spinbox didn't get added until 8.6
238 proc tspinbox {w args} {
239         global use_ttk
240         if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} {
241                 eval [linsert $args 0 ttk::spinbox $w]
242         } else {
243                 eval [linsert $args 0 spinbox $w]
244         }
245 }
246
247 # Create a text widget with any theme specific properties.
248 proc ttext {w args} {
249         global use_ttk
250         if {$use_ttk} {
251                 switch -- [ttk::style theme use] {
252                         "vista" - "xpnative" {
253                                 lappend args -highlightthickness 0 -borderwidth 0
254                         }
255                 }
256         }
257         set w [eval [linsert $args 0 text $w]]
258         if {$use_ttk} {
259                 if {[winfo class [winfo parent $w]] eq "EntryFrame"} {
260                         bind $w <FocusIn> {[winfo parent %W] state focus}
261                         bind $w <FocusOut> {[winfo parent %W] state !focus}
262                 }
263         }
264         return $w
265 }
266
267 # themed frame suitable for surrounding a text field.
268 proc textframe {w args} {
269         global use_ttk
270         if {$use_ttk} {
271                 if {[catch {ttk::style layout EntryFrame}]} {
272                         InitEntryFrame
273                 }
274                 eval [linsert $args 0 ttk::frame $w -class EntryFrame -style EntryFrame]
275         } else {
276                 eval [linsert $args 0 frame $w]
277         }
278         return $w
279 }
280
281 proc tentry {w args} {
282         global use_ttk
283         if {$use_ttk} {
284                 InitTheme
285                 ttk::entry $w -style Edged.Entry
286         } else {
287                 entry $w
288         }
289
290         rename $w _$w
291         interp alias {} $w {} tentry_widgetproc $w
292         eval [linsert $args 0 tentry_widgetproc $w configure]
293         return $w
294 }
295 proc tentry_widgetproc {w cmd args} {
296         global use_ttk
297         switch -- $cmd {
298                 state {
299                         if {$use_ttk} {
300                                 return [uplevel 1 [list _$w $cmd] $args]
301                         } else {
302                                 if {[lsearch -exact $args pressed] != -1} {
303                                         _$w configure -background lightpink
304                                 } else {
305                                         _$w configure -background lightgreen
306                                 }
307                         }
308                 }
309                 configure {
310                         if {$use_ttk} {
311                                 if {[set n [lsearch -exact $args -background]] != -1} {
312                                         set args [lreplace $args $n [incr n]]
313                                         if {[llength $args] == 0} {return}
314                                 }
315                         }
316                         return [uplevel 1 [list _$w $cmd] $args]
317                 }
318                 default { return [uplevel 1 [list _$w $cmd] $args] }
319         }
320 }
321
322 # Tk 8.6 provides a standard font selection dialog. This uses the native
323 # dialogs on Windows and MacOSX or a standard Tk dialog on X11.
324 proc tchoosefont {w title familyvar sizevar} {
325         if {[package vsatisfies [package provide Tk] 8.6]} {
326                 upvar #0 $familyvar family
327                 upvar #0 $sizevar size
328                 tk fontchooser configure -parent $w -title $title \
329                         -font [list $family $size] \
330                         -command [list on_choosefont $familyvar $sizevar]
331                 tk fontchooser show
332         } else {
333                 choose_font::pick $w $title $familyvar $sizevar
334         }
335 }
336
337 # Called when the Tk 8.6 fontchooser selects a font.
338 proc on_choosefont {familyvar sizevar font} {
339         upvar #0 $familyvar family
340         upvar #0 $sizevar size
341         set font [font actual $font]
342         set family [dict get $font -family]
343         set size [dict get $font -size]
344 }
345
346 # Local variables:
347 # mode: tcl
348 # indent-tabs-mode: t
349 # tab-width: 4
350 # End: