[Sumover-dev] [svn commit] r4403 - vic/branches/mpeg4/tcl

sumover-dev at cs.ucl.ac.uk sumover-dev at cs.ucl.ac.uk
Mon Mar 23 03:00:59 GMT 2009


Author: douglask
Date: Mon Mar 23 03:00:54 2009
New Revision: 4403

Modified:
   vic/branches/mpeg4/tcl/ui-main.tcl
   vic/branches/mpeg4/tcl/ui-resource.tcl

Log:
Tk 8.5 related fixes include using outline fonts and colour theme inherited from Gnome or KDE desktop


Modified: vic/branches/mpeg4/tcl/ui-main.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-main.tcl	(original)
+++ vic/branches/mpeg4/tcl/ui-main.tcl	Mon Mar 23 03:00:54 2009
@@ -542,12 +542,15 @@
 	set f [smallfont]
 	set stamp $w.stamp
 	frame $stamp -relief ridge -borderwidth 2
-	bind $stamp <Enter> "%W configure -background gray90"
-        if {[string match [ windowingsystem] "aqua"]} {
-                bind $stamp <Enter> "%W configure -background CornflowerBlue"
-        } else {
-                bind $stamp <Enter> "%W configure -background gray90"
-        }   
+	if {[string match [ windowingsystem] "aqua"]} {
+		bind $stamp <Enter> "%W configure -background CornflowerBlue"
+	} elseif {$::tk_version > 8.4} {
+		# correct approach would be to somehow query the theme for
+		# selectforeground and use that instead of hardcoding to white
+		bind $stamp <Enter> "%W configure -background white"
+	} else {
+		bind $stamp <Enter> "%W configure -background gray90"
+	}
 	bind $stamp <Leave> "%W configure -background [resource background]"
 	create_video_widget $stamp.video 80 60
 	global win_is_slow
@@ -555,18 +558,18 @@
 
 	# disable xvideo fro stamp video
 	attach_window $src $stamp.video false 
-        
+
 	if {[string match [ windowingsystem] "aqua"]} {
                 pack $stamp.video -side left -padx 2 -pady 2
                 pack $stamp -side left -anchor nw -padx {4 2} -pady 2
                 frame $w.r -padx 2
-        } else {
+	} else {
                 pack $stamp.video -side left -anchor c -padx 2
                 pack $stamp -side left -fill y
                 frame $w.r
-        }
-        
-	global V	
+	}
+
+	global V
 # Show sender window as raised
 	if { $src == [srctab local] } {
 	  frame $w.r.cw -relief groove -borderwidth 2 -bg gray20

Modified: vic/branches/mpeg4/tcl/ui-resource.tcl
==============================================================================
--- vic/branches/mpeg4/tcl/ui-resource.tcl	(original)
+++ vic/branches/mpeg4/tcl/ui-resource.tcl	Mon Mar 23 03:00:54 2009
@@ -102,12 +102,20 @@
 		set times14 [search_font $foundry times medium 14]
 	}
 
-	option add *Font $helv12b startupFile
-	option add Vic.medfont $helv12b startupFile
-	option add Vic.smallfont $helv10b startupFile
-	option add Vic.minifont $helv4b startupFile
-	option add Vic.helpfont $times14 startupFile
-	option add Vic.entryfont $helv10 startupFile
+	if {$::tk_version < 8.5} {
+		option add *Font $helv12b startupFile
+		option add Vic.medfont $helv12b startupFile
+		option add Vic.smallfont $helv10b startupFile
+		option add Vic.minifont $helv4b startupFile
+		option add Vic.helpfont $times14 startupFile
+		option add Vic.entryfont $helv10 startupFile
+	} else {
+		option add Vic.medfont TkDefaultFont
+		option add Vic.smallfont TkSmallCaptionFont
+		option add Vic.minifont TkIconFont
+		option add Vic.helpfont TkTooltipFont
+		option add Vic.entryfont TkTextFont
+	}
 
     }
 
@@ -134,7 +142,7 @@
 	# base priority from widgetDefault to 61 so that user's X resources
 	# won't override these.
 	#
-	if {$tcl_platform(platform) != "windows"} {
+	if {$tcl_platform(platform) != "windows" && $::tk_version < 8.5} {
 		tk_setPalette gray80
 		foreach pal [array names tkPalette] {
 			option add *$pal $tkPalette($pal) 61



More information about the Sumover-dev mailing list