Posted to tcl by patthoyts at Thu Dec 24 10:06:49 GMT 2009view raw
- # Reads the current Gtk+ theme colors using the gconftool and tries
- # to configure the menubar appropriately. This works OK for "New Wave" on
- # Ubuntu bit might not be so good for other themes.
- #
- # See /use/share/themes/New\ Wave/gtk-2.0/gtkrc
- #
- # Menu highlight is actually an image, this is a best attempt.
- #
- # You can apply this to tkchat by sourcing this code and calling gtkify::gtkify .mbar
- namespace eval gtkify {
- variable color_scheme
- # define manual defaults.
- array set color_scheme {
- fg_color #101010
- bg_color #E5E5E5
- base_color #FFFFFF
- text_color #1A1A1A
- selected_fg_color #1A1A1A
- selected_bg_color #FF8F4C
- tooltip_bg_color #FFE6C4
- tooltip_fg_color #330606
- menu_text_disabled #696969
- }
- }
- proc gtkify::get_menus {menu} {
- set r {}
- foreach child [winfo children $menu] {
- set r [concat $r $child [get_menus $child]]
- }
- return $r
- }
- proc gtkify::shade {factor color} {
- set r "#"
- foreach c [winfo rgb . $color] {
- append r [format %04x [expr {int($c * $factor)}]]
- }
- return $r
- }
- proc gtkify::lighter {color} {return [shade 1.3 $color]}
- proc gtkify::darker {color} {return [shade 0.3 $color]}
- proc gtkify::gtkify {menu} {
- variable color_scheme
- set interface /desktop/gnome/interface
- set theme_name [exec gconftool --get $interface/gtk_theme]
- set gui_font [exec gconftool --get $interface/font_name]
- set mono_font [exec gconftool --get $interface/monospace_font_name]
- if {![catch {exec gconftool --get $interface/menus_have_tearoff} tearoff]} {
- option add *Menu.tearOff $tearoff
- }
- if {![catch {exec gconftool --get $interface/color_scheme} scheme]} {
- foreach {name color} [split $scheme :\n] {
- set color_scheme($name) $color
- }
- }
- $menu configure \
- -foreground $color_scheme(bg_color) \
- -background [shade 0.38 $color_scheme(bg_color)] \
- -selectcolor $color_scheme(selected_bg_color) \
- -activebackground [shade 0.38 $color_scheme(bg_color)] \
- -activeforeground $color_scheme(base_color) \
- -activeborderwidth 0 \
- -borderwidth 0 \
- -relief flat
- foreach submenu [get_menus $menu] {
- $submenu configure \
- -foreground $color_scheme(text_color) \
- -background [shade 0.965 $color_scheme(base_color)] \
- -activeforeground $color_scheme(selected_fg_color) \
- -activebackground $color_scheme(selected_bg_color)
- }
- return $theme_name
- }
- #gtkify::gtkify .mbar