1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
|
# Functions for supporting the use of themed Tk widgets in git-gui.
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
proc InitTheme {} {
# Create a color label style (bg can be overridden by widget option)
ttk::style layout Color.TLabel {
Color.Label.border -sticky news -children {
Color.label.fill -sticky news -children {
Color.Label.padding -sticky news -children {
Color.Label.label -sticky news}}}}
eval [linsert [ttk::style configure TLabel] 0 \
ttk::style configure Color.TLabel]
ttk::style configure Color.TLabel \
-borderwidth 0 -relief flat -padding 2
ttk::style map Color.TLabel -background {{} gold}
# We also need a padded label.
ttk::style configure Padded.TLabel \
-padding {5 5} -borderwidth 1 -relief solid
# We need a gold frame.
ttk::style layout Gold.TFrame {
Gold.Frame.border -sticky nswe -children {
Gold.Frame.fill -sticky nswe}}
ttk::style configure Gold.TFrame -background gold -relief flat
# listboxes should have a theme border so embed in ttk::frame
ttk::style layout SListbox.TFrame {
SListbox.Frame.Entry.field -sticky news -border true -children {
SListbox.Frame.padding -sticky news
}
}
}
proc gold_frame {w args} {
global use_ttk
if {$use_ttk} {
eval [linsert $args 0 ttk::frame $w -style Gold.TFrame]
} else {
eval [linsert $args 0 frame $w -background gold]
}
}
proc tlabel {w args} {
global use_ttk
if {$use_ttk} {
set cmd [list ttk::label $w -style Color.TLabel]
foreach {k v} $args {
switch -glob -- $k {
-activebackground {}
default { lappend cmd $k $v }
}
}
eval $cmd
} else {
eval [linsert $args 0 label $w]
}
}
# The padded label gets used in the about class.
proc paddedlabel {w args} {
global use_ttk
if {$use_ttk} {
eval [linsert $args 0 ttk::label $w -style Padded.TLabel]
} else {
eval [linsert $args 0 label $w \
-padx 5 -pady 5 \
-justify left \
-anchor w \
-borderwidth 1 \
-relief solid]
}
}
# Create a toplevel for use as a dialog.
# If available, sets the EWMH dialog hint and if ttk is enabled
# place a themed frame over the surface.
proc Dialog {w args} {
eval [linsert $args 0 toplevel $w -class Dialog]
pave_toplevel $w
return $w
}
# Tk toplevels are not themed - so pave it over with a themed frame to get
# the base color correct per theme.
proc pave_toplevel {w} {
global use_ttk
if {$use_ttk && ![winfo exists $w.!paving]} {
set paving [ttk::frame $w.!paving]
place $paving -x 0 -y 0 -relwidth 1 -relheight 1
lower $paving
}
}
# Create a scrolled listbox with appropriate border for the current theme.
# On many themes the border for a scrolled listbox needs to go around the
# listbox and the scrollbar.
proc slistbox {w args} {
global use_ttk NS
if {$use_ttk} {
set f [ttk::frame $w -style SListbox.TFrame -padding 2]
} else {
set f [frame $w -relief flat]
}
if {[catch {
if {$use_ttk} {
eval [linsert $args 0 listbox $f.list -relief flat \
-highlightthickness 0 -borderwidth 0]
} else {
eval [linsert $args 0 listbox $f.list]
}
${NS}::scrollbar $f.vs -command [list $f.list yview]
$f.list configure -yscrollcommand [list $f.vs set]
grid $f.list $f.vs -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
bind $f.list <<ListboxSelect>> \
[list event generate $w <<ListboxSelect>>]
interp hide {} $w
interp alias {} $w {} $f.list
} err]} {
destroy $f
return -code error $err
}
return $w
}
# fetch the background color from a widget.
proc get_bg_color {w} {
global use_ttk
if {$use_ttk} {
set bg [ttk::style lookup [winfo class $w] -background]
} else {
set bg [$w cget -background]
}
return $bg
}
# ttk::spinbox didn't get added until 8.6
proc tspinbox {w args} {
global use_ttk
if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} {
eval [linsert $args 0 ttk::spinbox $w]
} else {
eval [linsert $args 0 spinbox $w]
}
}
# Tk 8.6 provides a standard font selection dialog. This uses the native
# dialogs on Windows and MacOSX or a standard Tk dialog on X11.
proc tchoosefont {w title familyvar sizevar} {
if {[package vsatisfies [package provide Tk] 8.6]} {
upvar #0 $familyvar family
upvar #0 $sizevar size
tk fontchooser configure -parent $w -title $title \
-font [list $family $size] \
-command [list on_choosefont $familyvar $sizevar]
tk fontchooser show
} else {
choose_font::pick $w $title $familyvar $sizevar
}
}
# Called when the Tk 8.6 fontchooser selects a font.
proc on_choosefont {familyvar sizevar font} {
upvar #0 $familyvar family
upvar #0 $sizevar size
set font [font actual $font]
set family [dict get $font -family]
set size [dict get $font -size]
}
# Local variables:
# mode: tcl
# indent-tabs-mode: t
# tab-width: 4
# End:
|