mingw: use real pid
[git/dscho.git] / git-gui / lib / themed.tcl
blob1da458673b557fe84ac8e430e97b7ad53c69a07a
1 # Functions for supporting the use of themed Tk widgets in git-gui.
2 # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
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
32 proc gold_frame {w args} {
33 global use_ttk
34 if {$use_ttk} {
35 eval [linsert $args 0 ttk::frame $w -style Gold.TFrame]
36 } else {
37 eval [linsert $args 0 frame $w -background gold]
41 proc tlabel {w args} {
42 global use_ttk
43 if {$use_ttk} {
44 set cmd [list ttk::label $w -style Color.TLabel]
45 foreach {k v} $args {
46 switch -glob -- $k {
47 -activebackground {}
48 default { lappend cmd $k $v }
51 eval $cmd
52 } else {
53 eval [linsert $args 0 label $w]
57 # The padded label gets used in the about class.
58 proc paddedlabel {w args} {
59 global use_ttk
60 if {$use_ttk} {
61 eval [linsert $args 0 ttk::label $w -style Padded.TLabel]
62 } else {
63 eval [linsert $args 0 label $w \
64 -padx 5 -pady 5 \
65 -justify left \
66 -anchor w \
67 -borderwidth 1 \
68 -relief solid]
72 # Create a toplevel for use as a dialog.
73 # If available, sets the EWMH dialog hint and if ttk is enabled
74 # place a themed frame over the surface.
75 proc Dialog {w args} {
76 eval [linsert $args 0 toplevel $w -class Dialog]
77 pave_toplevel $w
78 return $w
81 # Tk toplevels are not themed - so pave it over with a themed frame to get
82 # the base color correct per theme.
83 proc pave_toplevel {w} {
84 global use_ttk
85 if {$use_ttk && ![winfo exists $w.!paving]} {
86 set paving [ttk::frame $w.!paving]
87 place $paving -x 0 -y 0 -relwidth 1 -relheight 1
88 lower $paving
92 # Create a scrolled listbox with appropriate border for the current theme.
93 # On many themes the border for a scrolled listbox needs to go around the
94 # listbox and the scrollbar.
95 proc slistbox {w args} {
96 global use_ttk NS
97 if {$use_ttk} {
98 set f [ttk::frame $w -style SListbox.TFrame -padding 2]
99 } else {
100 set f [frame $w -relief flat]
102 if {[catch {
103 if {$use_ttk} {
104 eval [linsert $args 0 listbox $f.list -relief flat \
105 -highlightthickness 0 -borderwidth 0]
106 } else {
107 eval [linsert $args 0 listbox $f.list]
109 ${NS}::scrollbar $f.vs -command [list $f.list yview]
110 $f.list configure -yscrollcommand [list $f.vs set]
111 grid $f.list $f.vs -sticky news
112 grid rowconfigure $f 0 -weight 1
113 grid columnconfigure $f 0 -weight 1
114 bind $f.list <<ListboxSelect>> \
115 [list event generate $w <<ListboxSelect>>]
116 interp hide {} $w
117 interp alias {} $w {} $f.list
118 } err]} {
119 destroy $f
120 return -code error $err
122 return $w
125 # fetch the background color from a widget.
126 proc get_bg_color {w} {
127 global use_ttk
128 if {$use_ttk} {
129 set bg [ttk::style lookup [winfo class $w] -background]
130 } else {
131 set bg [$w cget -background]
133 return $bg
136 # ttk::spinbox didn't get added until 8.6
137 proc tspinbox {w args} {
138 global use_ttk
139 if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} {
140 eval [linsert $args 0 ttk::spinbox $w]
141 } else {
142 eval [linsert $args 0 spinbox $w]
146 # Tk 8.6 provides a standard font selection dialog. This uses the native
147 # dialogs on Windows and MacOSX or a standard Tk dialog on X11.
148 proc tchoosefont {w title familyvar sizevar} {
149 if {[package vsatisfies [package provide Tk] 8.6]} {
150 upvar #0 $familyvar family
151 upvar #0 $sizevar size
152 tk fontchooser configure -parent $w -title $title \
153 -font [list $family $size] \
154 -command [list on_choosefont $familyvar $sizevar]
155 tk fontchooser show
156 } else {
157 choose_font::pick $w $title $familyvar $sizevar
161 # Called when the Tk 8.6 fontchooser selects a font.
162 proc on_choosefont {familyvar sizevar font} {
163 upvar #0 $familyvar family
164 upvar #0 $sizevar size
165 set font [font actual $font]
166 set family [dict get $font -family]
167 set size [dict get $font -size]
170 # Local variables:
171 # mode: tcl
172 # indent-tabs-mode: t
173 # tab-width: 4
174 # End: