Mercurial > hg
comparison contrib/hgk @ 18805:6a0578d07024
hgk: update backgroud colour when Ttk is available
Ttk doesn't automatically set up Tk colour palette.
Because of that, Ttk controls look differently when used
together with old Tk controls. When we use Ttk controls,
we first query if we have any setting for the client
background, and if we do, we update Tk palette as well.
| author | Andrew Shadura <bugzilla@tut.by> |
|---|---|
| date | Sun, 10 Mar 2013 16:42:16 +0100 |
| parents | 870505ec3e56 |
| children | 932f5d3587c9 |
comparison
equal
deleted
inserted
replaced
| 18804:870505ec3e56 | 18805:6a0578d07024 |
|---|---|
| 28 interp alias {} ttk::button {} button | 28 interp alias {} ttk::button {} button |
| 29 interp alias {} ttk::frame {} frame | 29 interp alias {} ttk::frame {} frame |
| 30 interp alias {} ttk::label {} label | 30 interp alias {} ttk::label {} label |
| 31 interp alias {} ttk::scrollbar {} scrollbar | 31 interp alias {} ttk::scrollbar {} scrollbar |
| 32 interp alias {} ttk::optionMenu {} tk_optionMenu | 32 interp alias {} ttk::optionMenu {} tk_optionMenu |
| 33 | |
| 34 proc updatepalette {} {} | |
| 33 } else { | 35 } else { |
| 34 proc ::ttk::optionMenu {w varName firstValue args} { | 36 proc ::ttk::optionMenu {w varName firstValue args} { |
| 35 upvar #0 $varName var | 37 upvar #0 $varName var |
| 36 | 38 |
| 37 if {![info exists var]} { | 39 if {![info exists var]} { |
| 43 $w.menu add radiobutton -label $firstValue -variable $varName | 45 $w.menu add radiobutton -label $firstValue -variable $varName |
| 44 foreach i $args { | 46 foreach i $args { |
| 45 $w.menu add radiobutton -label $i -variable $varName | 47 $w.menu add radiobutton -label $i -variable $varName |
| 46 } | 48 } |
| 47 return $w.menu | 49 return $w.menu |
| 50 } | |
| 51 proc updatepalette {} { | |
| 52 catch { | |
| 53 tk_setPalette background [ttk::style lookup client -background] | |
| 54 } | |
| 48 } | 55 } |
| 49 } | 56 } |
| 50 | 57 |
| 51 if {[tk windowingsystem] eq "win32"} { | 58 if {[tk windowingsystem] eq "win32"} { |
| 52 | 59 |
| 118 ttk::style theme use clam | 125 ttk::style theme use clam |
| 119 } | 126 } |
| 120 | 127 |
| 121 } | 128 } |
| 122 | 129 |
| 130 updatepalette | |
| 123 | 131 |
| 124 # Unify right mouse button handling. | 132 # Unify right mouse button handling. |
| 125 # See "mouse buttons on macintosh" thread on comp.lang.tcl | 133 # See "mouse buttons on macintosh" thread on comp.lang.tcl |
| 126 if {[tk windowingsystem] eq "aqua"} { | 134 if {[tk windowingsystem] eq "aqua"} { |
| 127 event add <<B3>> <Control-ButtonPress-1> | 135 event add <<B3>> <Control-ButtonPress-1> |