Posted to tcl by patthoyts at Thu Dec 24 10:06:49 GMT 2009view raw

  1. # Reads the current Gtk+ theme colors using the gconftool and tries
  2. # to configure the menubar appropriately. This works OK for "New Wave" on
  3. # Ubuntu bit might not be so good for other themes.
  4. #
  5. # See /use/share/themes/New\ Wave/gtk-2.0/gtkrc
  6. #
  7. # Menu highlight is actually an image, this is a best attempt.
  8. #
  9. # You can apply this to tkchat by sourcing this code and calling gtkify::gtkify .mbar
  10.  
  11. namespace eval gtkify {
  12. variable color_scheme
  13. # define manual defaults.
  14. array set color_scheme {
  15. fg_color #101010
  16. bg_color #E5E5E5
  17. base_color #FFFFFF
  18. text_color #1A1A1A
  19. selected_fg_color #1A1A1A
  20. selected_bg_color #FF8F4C
  21. tooltip_bg_color #FFE6C4
  22. tooltip_fg_color #330606
  23. menu_text_disabled #696969
  24. }
  25. }
  26.  
  27. proc gtkify::get_menus {menu} {
  28. set r {}
  29. foreach child [winfo children $menu] {
  30. set r [concat $r $child [get_menus $child]]
  31. }
  32. return $r
  33. }
  34. proc gtkify::shade {factor color} {
  35. set r "#"
  36. foreach c [winfo rgb . $color] {
  37. append r [format %04x [expr {int($c * $factor)}]]
  38. }
  39. return $r
  40. }
  41.  
  42. proc gtkify::lighter {color} {return [shade 1.3 $color]}
  43.  
  44. proc gtkify::darker {color} {return [shade 0.3 $color]}
  45.  
  46. proc gtkify::gtkify {menu} {
  47. variable color_scheme
  48. set interface /desktop/gnome/interface
  49. set theme_name [exec gconftool --get $interface/gtk_theme]
  50. set gui_font [exec gconftool --get $interface/font_name]
  51. set mono_font [exec gconftool --get $interface/monospace_font_name]
  52. if {![catch {exec gconftool --get $interface/menus_have_tearoff} tearoff]} {
  53. option add *Menu.tearOff $tearoff
  54. }
  55. if {![catch {exec gconftool --get $interface/color_scheme} scheme]} {
  56. foreach {name color} [split $scheme :\n] {
  57. set color_scheme($name) $color
  58. }
  59. }
  60.  
  61. $menu configure \
  62. -foreground $color_scheme(bg_color) \
  63. -background [shade 0.38 $color_scheme(bg_color)] \
  64. -selectcolor $color_scheme(selected_bg_color) \
  65. -activebackground [shade 0.38 $color_scheme(bg_color)] \
  66. -activeforeground $color_scheme(base_color) \
  67. -activeborderwidth 0 \
  68. -borderwidth 0 \
  69. -relief flat
  70. foreach submenu [get_menus $menu] {
  71. $submenu configure \
  72. -foreground $color_scheme(text_color) \
  73. -background [shade 0.965 $color_scheme(base_color)] \
  74. -activeforeground $color_scheme(selected_fg_color) \
  75. -activebackground $color_scheme(selected_bg_color)
  76. }
  77. return $theme_name
  78. }
  79. #gtkify::gtkify .mbar