# Functions for supporting the use of themed Tk widgets in git-gui. # Copyright (C) 2009 Pat Thoyts 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 <> \ [list event generate $w <>] 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: