git-gui: allow Ctrl+T to toggle multiple paths
[git/git.git] / lib / themed.tcl
CommitLineData
c80d7be5
PT
1# Functions for supporting the use of themed Tk widgets in git-gui.
2# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
3
4proc 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 {
35927672
PT
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 }
c80d7be5
PT
79}
80
30508bc4
PT
81# Define a style used for the surround of text widgets.
82proc 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
c80d7be5
PT
132proc 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
141proc 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.
158proc 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.
175proc Dialog {w args} {
176 eval [linsert $args 0 toplevel $w -class Dialog]
30508bc4 177 catch {wm attributes $w -type dialog}
c80d7be5
PT
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.
184proc 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.
196proc 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.
227proc 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
238proc 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
30508bc4
PT
247# Create a text widget with any theme specific properties.
248proc 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.
268proc 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
35927672
PT
281proc 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}
295proc 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
c80d7be5
PT
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.
324proc 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.
338proc 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: