[Tkabber-dev] r878 - in trunk/tkabber: . plugins/unix

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Jan 17 23:54:13 MSK 2007


Author: sergei
Date: 2007-01-17 23:54:10 +0300 (Wed, 17 Jan 2007)
New Revision: 878

Added:
   trunk/tkabber/plugins/unix/icon.tcl
Modified:
   trunk/tkabber/ChangeLog
Log:
	* plugins/unix/icon.tcl: Added plugin, which sets Tkabber titlebar
	  icons. It uses [wm iconphoto], so, it works with Tk 8.5 or newer.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-01-16 22:11:52 UTC (rev 877)
+++ trunk/tkabber/ChangeLog	2007-01-17 20:54:10 UTC (rev 878)
@@ -1,3 +1,8 @@
+2007-01-17  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/unix/icon.tcl: Added plugin, which sets Tkabber titlebar
+	  icons. It uses [wm iconphoto], so, it works with Tk 8.5 or newer.
+
 2007-01-16  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/chat/me_command.tcl, plugins/chat/nick_colors.tcl: Fixed

Added: trunk/tkabber/plugins/unix/icon.tcl
===================================================================
--- trunk/tkabber/plugins/unix/icon.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/unix/icon.tcl	2007-01-17 20:54:10 UTC (rev 878)
@@ -0,0 +1,53 @@
+# $Id$
+# Titlebar icons support. Works with Tk 8.5 or newer.
+
+if {[info tclversion] < 8.5} return
+
+##########################################################################
+
+namespace eval icon {
+    hook::add finload_hook [namespace current]::win_icons
+}
+
+##########################################################################
+
+proc icon::win_icons {} {
+    wm iconphoto . roster/user/unavailable
+
+    trace variable ::curuserstatus w [namespace code update]
+
+    foreach tag [list Toplevel Chat JBrowser JDisco] {
+	bind $tag <Map> \
+	     [list [namespace code win_icon_setup] %W $tag]
+    }
+}
+
+##########################################################################
+
+proc icon::win_icon_setup {w tag} {
+    if {[winfo toplevel $w] != $w} return
+
+    switch -- $tag {
+	Chat {
+	    wm iconphoto $w roster/conference/available
+	}
+	JBrowser -
+	JDisco {
+	    wm iconphoto $w roster/user/available
+	}
+	default {
+	    wm iconphoto $w roster/user/available
+	}
+    }
+}
+
+##########################################################################
+
+proc icon::update {name1 {name2 ""} {op ""}} {
+    global curuserstatus
+
+    wm iconphoto . roster/user/$curuserstatus
+}
+
+##########################################################################
+


Property changes on: trunk/tkabber/plugins/unix/icon.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list