git/git-gui/lib/themed.tcl
Junio C Hamano 3eae308700 git-gui 0.21.0
-----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1
 
 iQIcBAABCAAGBQJYCJqmAAoJEDn3Aot9nM55uKQP/11BTzhOr9K3SLzwCr01ylGP
 94AOA511vx3fIX5aWQ29S96tGbluo73RdbVsWFKKJcKSErpFPscFEiRkyjeMXE2T
 yWWOPOg08tm28ppZNp0Kqjb8VykUUKuG6gVT59DNFUZUqHYQbiQy+t8nwT+Qow3U
 dvo6lksovfSaW2FORWIi5KF5gD4v2F9qsbFgr725a8UoBrOmF0SWaCG4/ZYj0WxF
 0rq8LjpvmMuQqd06DAoGMIsHa71R61En2QWfJ4YoE5+QRq8wQl37FmX+ojiA1rzY
 CG/vJO2Tw4v54wHKK1TCXG7LR4JhTcQZOa6zd8HHsPRn+viGDCMVUG9uMewfxH+m
 F47EVMxiKf0subm3fUhycqkvso0r6mOAddhz47RKT7tqU4XOnhPyGw0x6m7evawg
 Sz2+fOK3wwX2Qec5o3vBZKaEcOftSrLuZmbi5/j43crvcf+OAs9s/jdq/Ulpkks2
 JI2i0DLzHABTbDn6QsuysEZnituks8T8Fdm5NOldritgBNVY81ifatekFscxt6Ct
 OrT9eGJk6iZiX1RvS+R7wykKJCBkxiyHqM8vSj5tPWjApgtnopPMudzNX41geaL9
 ADeb8LVMTTNL/md8KED0deypilcPNnPbW035rAbyCpAsKbtgO3zdfzdzxsQ+dIvc
 MQpCDP5QPPr3toRVdNmb
 =VyhL
 -----END PGP SIGNATURE-----

Merge tag 'gitgui-0.21.0' of git://repo.or.cz/git-gui

git-gui 0.21.0

* tag 'gitgui-0.21.0' of git://repo.or.cz/git-gui: (22 commits)
  git-gui: set version 0.21
  git-gui: Mark 'All' in remote.tcl for translation
  git-gui i18n: Updated Bulgarian translation (565,0f,0u)
  git-gui: avoid persisting modified author identity
  git-gui: handle the encoding of Git's output correctly
  git-gui: unicode file name support on windows
  git-gui: Update Russian translation
  git-gui: maintain backwards compatibility for merge syntax
  git-gui i18n: mark string in lib/error.tcl for translation
  git-gui: fix incorrect use of Tcl append command
  git-gui i18n: mark "usage:" strings for translation
  git-gui i18n: internationalize use of colon punctuation
  git-gui: ensure the file in the diff pane is in the list of selected files
  git-gui: support for $FILENAMES in tool definitions
  git-gui: fix initial git gui message encoding
  git-gui/po/glossary/txt-to-pot.sh: use the $( ... ) construct for command substitution
  git-gui (Windows): use git-gui.exe in `Create Desktop Shortcut`
  git-gui: fix detection of Cygwin
  Amend tab ordering and text widget border and highlighting.
  Allow keyboard control to work in the staging widgets.
  ...
2016-10-20 09:33:17 -07:00

350 lines
9.8 KiB
Tcl

# 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
}
}
# Handle either current Tk or older versions of 8.5
if {[catch {set theme [ttk::style theme use]}]} {
set theme $::ttk::currentTheme
}
if {[lsearch -exact {default alt classic clam} $theme] != -1} {
# Simple override of standard ttk::entry to change the field
# packground according to a state flag. We should use 'user1'
# but not all versions of 8.5 support that so make use of 'pressed'
# which is not normally in use for entry widgets.
ttk::style layout Edged.Entry [ttk::style layout TEntry]
ttk::style map Edged.Entry {*}[ttk::style map TEntry]
ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
-fieldbackground lightgreen
ttk::style map Edged.Entry -fieldbackground {
{pressed !disabled} lightpink
}
} else {
# For fancier themes, in particular the Windows ones, the field
# element may not support changing the background color. So instead
# override the fill using the default fill element. If we overrode
# the vista theme field element we would loose the themed border
# of the widget.
catch {
ttk::style element create color.fill from default
}
ttk::style layout Edged.Entry {
Edged.Entry.field -sticky nswe -border 0 -children {
Edged.Entry.border -sticky nswe -border 1 -children {
Edged.Entry.padding -sticky nswe -children {
Edged.Entry.color.fill -sticky nswe -children {
Edged.Entry.textarea -sticky nswe
}
}
}
}
}
ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \
-background lightgreen -padding 0 -borderwidth 0
ttk::style map Edged.Entry {*}[ttk::style map TEntry] \
-background {{pressed !disabled} lightpink}
}
if {[lsearch [bind . <<ThemeChanged>>] InitTheme] == -1} {
bind . <<ThemeChanged>> +[namespace code [list InitTheme]]
}
}
# Define a style used for the surround of text widgets.
proc InitEntryFrame {} {
ttk::style theme settings default {
ttk::style layout EntryFrame {
EntryFrame.field -sticky nswe -border 0 -children {
EntryFrame.fill -sticky nswe -children {
EntryFrame.padding -sticky nswe
}
}
}
ttk::style configure EntryFrame -padding 1 -relief sunken
ttk::style map EntryFrame -background {}
}
ttk::style theme settings classic {
ttk::style configure EntryFrame -padding 2 -relief sunken
ttk::style map EntryFrame -background {}
}
ttk::style theme settings alt {
ttk::style configure EntryFrame -padding 2
ttk::style map EntryFrame -background {}
}
ttk::style theme settings clam {
ttk::style configure EntryFrame -padding 2
ttk::style map EntryFrame -background {}
}
# Ignore errors for missing native themes
catch {
ttk::style theme settings winnative {
ttk::style configure EntryFrame -padding 2
}
ttk::style theme settings xpnative {
ttk::style configure EntryFrame -padding 1
ttk::style element create EntryFrame.field vsapi \
EDIT 1 {disabled 4 focus 3 active 2 {} 1} -padding 1
}
ttk::style theme settings vista {
ttk::style configure EntryFrame -padding 2
ttk::style element create EntryFrame.field vsapi \
EDIT 6 {disabled 4 focus 3 active 2 {} 1} -padding 2
}
}
bind EntryFrame <Enter> {%W instate !disabled {%W state active}}
bind EntryFrame <Leave> {%W state !active}
bind EntryFrame <<ThemeChanged>> {
set pad [ttk::style lookup EntryFrame -padding]
%W configure -padding [expr {$pad eq {} ? 1 : $pad}]
}
}
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]
catch {wm attributes $w -type 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]
}
}
# Create a text widget with any theme specific properties.
proc ttext {w args} {
global use_ttk
if {$use_ttk} {
switch -- [ttk::style theme use] {
"vista" - "xpnative" {
lappend args -highlightthickness 0 -borderwidth 0
}
}
}
set w [eval [linsert $args 0 text $w]]
if {$use_ttk} {
if {[winfo class [winfo parent $w]] eq "EntryFrame"} {
bind $w <FocusIn> {[winfo parent %W] state focus}
bind $w <FocusOut> {[winfo parent %W] state !focus}
}
}
return $w
}
# themed frame suitable for surrounding a text field.
proc textframe {w args} {
global use_ttk
if {$use_ttk} {
if {[catch {ttk::style layout EntryFrame}]} {
InitEntryFrame
}
eval [linsert $args 0 ttk::frame $w -class EntryFrame -style EntryFrame]
} else {
eval [linsert $args 0 frame $w]
}
return $w
}
proc tentry {w args} {
global use_ttk
if {$use_ttk} {
InitTheme
ttk::entry $w -style Edged.Entry
} else {
entry $w
}
rename $w _$w
interp alias {} $w {} tentry_widgetproc $w
eval [linsert $args 0 tentry_widgetproc $w configure]
return $w
}
proc tentry_widgetproc {w cmd args} {
global use_ttk
switch -- $cmd {
state {
if {$use_ttk} {
return [uplevel 1 [list _$w $cmd] $args]
} else {
if {[lsearch -exact $args pressed] != -1} {
_$w configure -background lightpink
} else {
_$w configure -background lightgreen
}
}
}
configure {
if {$use_ttk} {
if {[set n [lsearch -exact $args -background]] != -1} {
set args [lreplace $args $n [incr n]]
if {[llength $args] == 0} {return}
}
}
return [uplevel 1 [list _$w $cmd] $args]
}
default { return [uplevel 1 [list _$w $cmd] $args] }
}
}
# 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: