[Tkabber-dev] r717 - in trunk/tkabber-plugins: . checkers chess reversi traffic traffic/msgs

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Sep 16 22:42:51 MSD 2006


Author: sergei
Date: 2006-09-16 22:42:43 +0400 (Sat, 16 Sep 2006)
New Revision: 717

Added:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/traffic/
   trunk/tkabber-plugins/traffic/Changelog
   trunk/tkabber-plugins/traffic/msgs/
   trunk/tkabber-plugins/traffic/msgs/ru.msg
   trunk/tkabber-plugins/traffic/traffic.tcl
   trunk/tkabber-plugins/traffic/version.txt
Modified:
   trunk/tkabber-plugins/checkers/checkers.tcl
   trunk/tkabber-plugins/chess/chess.tcl
   trunk/tkabber-plugins/reversi/reversi.tcl
Log:
	* chess/chess.tcl, checkers/checkers.tcl, reversi/reversi.tcl:
	  Made games using hook::run with upvar instead of hook::foldl
	  (it looks more "ticklish"). Improved packing of game history
	  windows.

	* traffic/*: Added new traffic accounting plugin. It counts
	  total length of unencrypted and/or uncompressed XML stanzas
	  only (thanks to Artem Borodin).


Added: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	                        (rev 0)
+++ trunk/tkabber-plugins/ChangeLog	2006-09-16 18:42:43 UTC (rev 717)
@@ -0,0 +1,11 @@
+2006-09-16  Sergei Golovan  <sgolovan at nes.ru>
+
+	* chess/chess.tcl, checkers/checkers.tcl, reversi/reversi.tcl:
+	  Made games using hook::run with upvar instead of hook::foldl
+	  (it looks more "ticklish"). Improved packing of game history
+	  windows.
+
+	* traffic/*: Added new traffic accounting plugin. It counts
+	  total length of unencrypted and/or uncompressed XML stanzas
+	  only (thanks to Artem Borodin).
+

Modified: trunk/tkabber-plugins/checkers/checkers.tcl
===================================================================
--- trunk/tkabber-plugins/checkers/checkers.tcl	2006-09-16 16:42:52 UTC (rev 716)
+++ trunk/tkabber-plugins/checkers/checkers.tcl	2006-09-16 18:42:43 UTC (rev 717)
@@ -592,11 +592,11 @@
     #label $w.history -text [::msgcat::mc "History"]
     #pack $w.history -side top -anchor w
     set hsw [ScrolledWindow $w.hsw]
-    pack $hsw -side top -fill x
+    pack $hsw -side top -fill x -expand yes
     set tabstop1 [font measure $font "99.."]
     set tabstop2 [font measure $font "99..Qa8-a8+= "]
     set ht [text $w.text -font $font -tabs "$tabstop1 $tabstop2" -wrap word \
-		 -state disabled]
+		 -height 60 -state disabled]
     $ht tag configure attention -foreground [option get $ht errorForeground Text]
     $hsw setwidget $ht
     set flags(hw) $ht
@@ -1691,13 +1691,15 @@
 hook::add roster_jid_popup_menu_hook \
     [namespace current]::checkers::add_groupchat_user_menu_item 49
 
-proc checkers::iq_create {acc connid from child} {
+proc checkers::iq_create {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
     lassign [split [jlib::wrapper:getattr $vars type] ":"] cathegory game
 
     if {$cathegory != "checkers"} {
-	return $acc
+	return
     }
 
     switch -- $game {
@@ -1713,32 +1715,32 @@
 		    white -
 		    black { }
 		    default {
-			return [list error modify bad-request]
+			set var [list error modify bad-request]
 		    }
 		}
 	    } else {
 		set color white
 	    }
-	    return [[namespace current]::invited_dialog \
-			$game $connid $from \
-			[jlib::wrapper:getattr $vars id] \
-			$color]
+	    set var [[namespace current]::invited_dialog \
+			 $game $connid $from \
+			 [jlib::wrapper:getattr $vars id] \
+			 $color]
 	}
-	default {
-	    return $acc
-	}
     }
+    return
 }
 
 hook::add games_board_create_hook [namespace current]::checkers::iq_create
 
-proc checkers::iq_turn {acc connid from child} {
+proc checkers::iq_turn {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
     lassign [split [jlib::wrapper:getattr $vars type] ":"] cathegory game
 
     if {$cathegory != "checkers"} {
-	return $acc
+	return
     }
 
     switch -- $game {
@@ -1750,15 +1752,13 @@
 	italian {
 	    set gid [make_gid $from [jlib::wrapper:getattr $vars id]]
 	    if {[exists $gid]} {
-		return [[namespace current]::turn_recv $gid $children]
+		set var [[namespace current]::turn_recv $gid $children]
 	    } else {
-		return [list error cancel item-not-found]
+		set var [list error cancel item-not-found]
 	    }
 	}
-	default {
-	    return $acc
-	}
     }
+    return
 }
 
 hook::add games_board_turn_hook [namespace current]::checkers::iq_turn
@@ -1766,18 +1766,18 @@
 
 # Common games:board part
 proc iq_games_board_create {connid from child} {
-    hook::foldl games_board_create_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_create_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set create games:board \
     [namespace current]::iq_games_board_create
 
 proc iq_games_board_turn {connid from child} {
-    hook::foldl games_board_turn_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_turn_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set turn games:board \

Modified: trunk/tkabber-plugins/chess/chess.tcl
===================================================================
--- trunk/tkabber-plugins/chess/chess.tcl	2006-09-16 16:42:52 UTC (rev 716)
+++ trunk/tkabber-plugins/chess/chess.tcl	2006-09-16 18:42:43 UTC (rev 717)
@@ -548,11 +548,11 @@
     #label $w.history -text [::msgcat::mc "History"]
     #pack $w.history -side top -anchor w
     set hsw [ScrolledWindow $w.hsw]
-    pack $hsw -side top -fill x
+    pack $hsw -side top -fill x -expand yes
     set tabstop1 [font measure $font "99.."]
     set tabstop2 [font measure $font "99..$piece_name(wq)a8-a8+= "]
     set ht [text $w.text -font $font -tabs "$tabstop1 $tabstop2" -wrap word \
-		 -state disabled]
+		 -height 60 -state disabled]
     $ht tag configure attention -foreground [option get $ht errorForeground Text]
     $hsw setwidget $ht
     set flags(hw) $ht
@@ -1682,52 +1682,48 @@
 hook::add roster_jid_popup_menu_hook \
     [namespace current]::chess::add_groupchat_user_menu_item 48
 
-proc chess::iq_create {acc connid from child} {
+proc chess::iq_create {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    switch -- [jlib::wrapper:getattr $vars type] {
-	chess {
-	    if {[jlib::wrapper:isattr $vars color]} {
-		set color [jlib::wrapper:getattr $vars color]
-		switch -- $color {
-		    white -
-		    black { }
-		    default {
-			return [list error modify bad-request]
-		    }
+    if {[jlib::wrapper:getattr $vars type] == "chess"} {
+	if {[jlib::wrapper:isattr $vars color]} {
+	    set color [jlib::wrapper:getattr $vars color]
+	    switch -- $color {
+		white -
+		black { }
+		default {
+		    set var [list error modify bad-request]
 		}
-	    } else {
-		set color white
 	    }
-	    return [[namespace current]::invited_dialog \
-			$connid $from \
-			[jlib::wrapper:getattr $vars id] \
-			$color]
+	} else {
+	    set color white
 	}
-	default {
-	    return $acc
-	}
+	set var [[namespace current]::invited_dialog \
+		     $connid $from \
+		     [jlib::wrapper:getattr $vars id] \
+		     $color]
     }
+    return
 }
 
 hook::add games_board_create_hook [namespace current]::chess::iq_create
 
-proc chess::iq_turn {acc connid from child} {
+proc chess::iq_turn {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    switch -- [jlib::wrapper:getattr $vars type] {
-	chess {
-	    set gid [make_gid $from [jlib::wrapper:getattr $vars id]]
-	    if {[exists $gid]} {
-		return [[namespace current]::turn_recv $gid $children]
-	    } else {
-		return [list error cancel item-not-found]
-	    }
+    if {[jlib::wrapper:getattr $vars type] == "chess"} {
+	set gid [make_gid $from [jlib::wrapper:getattr $vars id]]
+	if {[exists $gid]} {
+	    set var [[namespace current]::turn_recv $gid $children]
+	} else {
+	    set var [list error cancel item-not-found]
 	}
-	default {
-	    return $acc
-	}
     }
+    return
 }
 
 hook::add games_board_turn_hook [namespace current]::chess::iq_turn
@@ -1735,18 +1731,18 @@
 
 # Common games:board part
 proc iq_games_board_create {connid from child} {
-    hook::foldl games_board_create_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_create_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set create games:board \
     [namespace current]::iq_games_board_create
 
 proc iq_games_board_turn {connid from child} {
-    hook::foldl games_board_turn_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_turn_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set turn games:board \

Modified: trunk/tkabber-plugins/reversi/reversi.tcl
===================================================================
--- trunk/tkabber-plugins/reversi/reversi.tcl	2006-09-16 16:42:52 UTC (rev 716)
+++ trunk/tkabber-plugins/reversi/reversi.tcl	2006-09-16 18:42:43 UTC (rev 717)
@@ -462,11 +462,11 @@
     #label $w.history -text [::msgcat::mc "History"]
     #pack $w.history -side top -anchor w
     set hsw [ScrolledWindow $w.hsw]
-    pack $hsw -side top -fill x
+    pack $hsw -side top -fill x -expand yes
     set tabstop1 [font measure $font "99.."]
     set tabstop2 [font measure $font "99..Qa8-a8+= "]
     set ht [text $w.text -font $font -tabs "$tabstop1 $tabstop2" -wrap word \
-		 -state disabled]
+		 -height 60 -state disabled]
     $ht tag configure attention -foreground [option get $ht errorForeground Text]
     $hsw setwidget $ht
     set flags(hw) $ht
@@ -1128,52 +1128,48 @@
 hook::add roster_jid_popup_menu_hook \
     [namespace current]::reversi::add_groupchat_user_menu_item 51
 
-proc reversi::iq_create {acc connid from child} {
+proc reversi::iq_create {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    switch -- [jlib::wrapper:getattr $vars type] {
-	reversi {
-	    if {[jlib::wrapper:isattr $vars color]} {
-		set color [jlib::wrapper:getattr $vars color]
-		switch -- $color {
-		    white -
-		    black { }
-		    default {
-			return [list error modify bad-request]
-		    }
+    if {[jlib::wrapper:getattr $vars type] == "reversi"} {
+	if {[jlib::wrapper:isattr $vars color]} {
+	    set color [jlib::wrapper:getattr $vars color]
+	    switch -- $color {
+		white -
+		black { }
+		default {
+		    set var [list error modify bad-request]
 		}
-	    } else {
-		set color white
 	    }
-	    return [[namespace current]::invited_dialog \
-			$connid $from \
-			[jlib::wrapper:getattr $vars id] \
-			$color]
+	} else {
+	    set color white
 	}
-	default {
-	    return $acc
-	}
+	set var [[namespace current]::invited_dialog \
+		     $connid $from \
+		     [jlib::wrapper:getattr $vars id] \
+		     $color]
     }
+    return
 }
 
 hook::add games_board_create_hook [namespace current]::reversi::iq_create
 
-proc reversi::iq_turn {acc connid from child} {
+proc reversi::iq_turn {varname connid from child} {
+    upvar 2 $varname var
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    switch -- [jlib::wrapper:getattr $vars type] {
-	reversi {
-	    set gid [make_gid $from [jlib::wrapper:getattr $vars id]]
-	    if {[exists $gid]} {
-		return [[namespace current]::turn_recv $gid $children]
-	    } else {
-		return [list error cancel item-not-found]
-	    }
+    if {[jlib::wrapper:getattr $vars type] == "reversi"} {
+	set gid [make_gid $from [jlib::wrapper:getattr $vars id]]
+	if {[exists $gid]} {
+	    set var [[namespace current]::turn_recv $gid $children]
+	} else {
+	    set var [list error cancel item-not-found]
 	}
-	default {
-	    return $acc
-	}
     }
+    return
 }
 
 hook::add games_board_turn_hook [namespace current]::reversi::iq_turn
@@ -1181,18 +1177,18 @@
 
 # Common games:board part
 proc iq_games_board_create {connid from child} {
-    hook::foldl games_board_create_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_create_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set create games:board \
     [namespace current]::iq_games_board_create
 
 proc iq_games_board_turn {connid from child} {
-    hook::foldl games_board_turn_hook \
-	[list error cancel feature-not-implemented] \
-	$connid $from $child
+    set res [list error cancel feature-not-implemented]
+    hook::run games_board_turn_hook res $connid $from $child
+    return $res
 }
 
 iq::register_handler set turn games:board \

Added: trunk/tkabber-plugins/traffic/Changelog
===================================================================
--- trunk/tkabber-plugins/traffic/Changelog	                        (rev 0)
+++ trunk/tkabber-plugins/traffic/Changelog	2006-09-16 18:42:43 UTC (rev 717)
@@ -0,0 +1 @@
+http://wiki.tkabber.jabe.ru/index.php/Plugins/Traffic/Changelog


Property changes on: trunk/tkabber-plugins/traffic/Changelog
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Added: trunk/tkabber-plugins/traffic/msgs/ru.msg
===================================================================
--- trunk/tkabber-plugins/traffic/msgs/ru.msg	                        (rev 0)
+++ trunk/tkabber-plugins/traffic/msgs/ru.msg	2006-09-16 18:42:43 UTC (rev 717)
@@ -0,0 +1,26 @@
+# $Id$
+::msgcat::mcset ru "Pres IN"
+::msgcat::mcset ru "Pres OUT"
+::msgcat::mcset ru "Iq IN"
+::msgcat::mcset ru "Iq OUT"
+::msgcat::mcset ru "Msg IN"
+::msgcat::mcset ru "Msg OUT"
+::msgcat::mcset ru "All IN"
+::msgcat::mcset ru "All OUT"
+::msgcat::mcset ru "On" "Вкл"
+::msgcat::mcset ru "Off" "Выкл"
+::msgcat::mcset ru "Plugins options." "Параметры расширений."
+::msgcat::mcset ru "Traffic plugin options." "Параметры модуля по подсчету трафика."
+::msgcat::mcset ru "Show nick instead of JID." "Показывать ник вместо JID-а."
+::msgcat::mcset ru "Use human-readable counters with K, M, G." "Использовать читабельные счетчики с K, M, G."
+::msgcat::mcset ru "Traffic statistics" "Статистика по трафику"
+::msgcat::mcset ru "Traffic" "Трафик"
+::msgcat::mcset ru "Refresh" "Обновить"
+::msgcat::mcset ru "Show XML" "XML"
+::msgcat::mcset ru "Save" "Сохранить"
+::msgcat::mcset ru "Reset" "Сбросить"
+::msgcat::mcset ru "Timer:" "Таймер:"
+::msgcat::mcset ru "JID" 
+::msgcat::mcset ru "Total" "Всего"
+::msgcat::mcset ru "A you sure you want to reset counters?" "Вы уверены, что хотите сбросить счетчики?"
+


Property changes on: trunk/tkabber-plugins/traffic/msgs/ru.msg
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Added: trunk/tkabber-plugins/traffic/traffic.tcl
===================================================================
--- trunk/tkabber-plugins/traffic/traffic.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/traffic/traffic.tcl	2006-09-16 18:42:43 UTC (rev 717)
@@ -0,0 +1,450 @@
+# $Id$
+# This plugin counts in and out bytes per JID.
+#
+# Bugs and feature request send to feez at jabber.ru
+
+namespace eval traffic {
+
+    set sysenc [encoding system]
+    encoding system utf-8
+    ::msgcat::mcload [file join [file dirname [info script]] msgs]
+    encoding system $sysenc
+    unset sysenc
+    
+    array set stats {}    
+    array set jids {}
+
+    # for table
+    array set names [list  \
+			presence,in  	[::msgcat::mc "Pres IN"] \
+			presence,out 	[::msgcat::mc "Pres OUT"] \
+                        iq,in 		[::msgcat::mc "Iq IN"] \
+                        iq,out 		[::msgcat::mc "Iq OUT"] \
+                        message,in 	[::msgcat::mc "Msg IN"] \
+                        message,out 	[::msgcat::mc "Msg OUT"] \
+                        total,in 	[::msgcat::mc "All IN"] \
+                        total,out 	[::msgcat::mc "All OUT"]]
+    set columns [list presence,in presence,out iq,in iq,out message,in message,out total,in total,out]
+    set sort_order total,in
+
+    set current_connid 0 
+    set wished_connid "0 None"
+
+    set timer 5
+    set timer_state 0
+    set timer_id {}
+    array set timer_names [list 0 [::msgcat::mc "On"] 1 [::msgcat::mc "Off"] ]
+    
+
+    # Options
+    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
+    
+    custom::defgroup Traffic [::msgcat::mc "Traffic plugin options."] -group Plugins
+
+    custom::defvar options(show_nick) 1 \
+        [::msgcat::mc "Show nick instead of JID."] \
+        -type boolean -group Traffic
+    
+    custom::defvar options(human_readable) 1 \
+        [::msgcat::mc "Use human-readable counters with K, M, G."] \
+        -type boolean -group Traffic
+
+    trace variable options(show_nick) w [list [namespace current]::clear_and_refresh]
+}
+
+# ############################
+# Handlers 
+
+proc traffic::handle_inout {connid xmldata size prefix attr} {
+    variable stat
+    variable jids
+    variable columns
+    variable names
+    
+    jlib::wrapper:splitxml $xmldata tag vars isempty chdata children
+    
+    set jid [jlib::wrapper:getattr $vars $attr]
+    if { [cequal $jid {}] } { 
+	set jid "SERVER"
+    } else {
+	catch { set jid [node_and_server_from_jid $jid] }
+    }
+    
+    if {![info exists jids($connid,$jid)]} {
+	
+	# create
+        set jids($connid,$jid) 1
+	lappend jids($connid,jids) $jid
+
+	# initialize counters
+	foreach column $columns {
+	    set stat($connid,$jid,$column) 0
+	}    
+    }	
+    
+    # increment counters
+    if { [info exists names($tag,$prefix)] } {
+        incr stat($connid,$jid,$tag,$prefix) $size 
+    }
+    incr stat($connid,$jid,total,$prefix) $size
+}
+
+proc ::LOG_INPUT_SIZE {connid xmldata size} \
+    "[namespace current]::traffic::handle_inout \$connid \$xmldata \$size in from"
+
+proc ::LOG_OUTPUT_SIZE {connid xmldata size} \
+    "[namespace current]::traffic::handle_inout \$connid \$xmldata \$size out to"
+
+
+# ############################
+# GUI
+
+proc traffic::get_connections { } {
+    set res [list "0 None"]
+    foreach con [jlib::connections] {
+	lappend res [list $con [jlib::connection_jid $con]]
+    }
+    return $res
+}
+
+proc traffic::open_window { } {
+    
+    global font
+    variable columns
+    variable names
+    variable current_connid    
+    variable timer_state 
+    variable timer_names
+    
+    # create widgets
+    set w .traffic_stats
+    if {[winfo exists $w]} {
+	return
+    }
+
+    # base widget
+    add_win $w -title [::msgcat::mc "Traffic statistics"] \
+	-tabtitle [::msgcat::mc "Traffic"] \
+	-class Traffic
+
+    # button box
+    set tools [frame $w.tools -borderwidth 5]
+    pack $tools -side top -anchor w -fill x        
+	
+    button $tools.refresh -text [::msgcat::mc "Refresh"] \
+        -command [list [namespace current]::refresh]
+    pack $tools.refresh -side right -anchor w
+
+    set connections [get_connections]    
+    ComboBox $tools.connection -textvariable [namespace current]::wished_connid \
+	-values $connections -height [expr [llength $connections] + 1] -editable 0 \
+	-modifycmd [list [namespace current]::refresh]
+    pack $tools.connection -side right -anchor w
+    unset connections
+    
+    button $tools.show_xml -text [::msgcat::mc "Show XML"] \
+        -command [list ::plugins::rawxml::open_window]
+    pack $tools.show_xml -side left -anchor w
+
+    button $tools.save -text [::msgcat::mc "Save"] \
+        -command [list [namespace current]::save_stat]
+    pack $tools.save -side left -anchor w
+
+    button $tools.reset -text [::msgcat::mc "Reset"] \
+        -command [list [namespace current]::reset]
+    pack $tools.reset -side left -anchor w
+
+
+    pack [label $tools.timerlab -text [::msgcat::mc "Timer:"]] -side left -anchor w
+
+    Spinbox $tools.timerspin 1 100000 1 [namespace current]::timer
+    $tools.timerspin configure -width 4
+    pack $tools.timerspin -side left -anchor w
+
+    button $tools.timer -text $timer_names($timer_state) \
+        -command [list [namespace current]::turn_timer]
+    pack $tools.timer -side left -anchor w
+    
+
+    # creatе grid
+    set sw [ScrolledWindow $w.sw -relief sunken -bd 1]
+    pack $sw -side top -fill both -expand yes
+
+    set sf [ScrollableFrame $w.sf]
+    $sw setwidget $sf
+    set f [$sf getframe]
+              
+    
+    # fill grid header
+    grid [label $f.titlejid -text [::msgcat::mc "JID"] -width 20] -row 0 -column 0 -sticky w
+    set i 1
+    foreach col $columns {
+	
+        set b [Button $f.titlelabel$i -text $names($col) \
+		    -command [list [namespace current]::sort $col]]
+        grid $b -row 0 -column $i -sticky we
+
+        incr i
+    }
+    
+    refresh
+}
+
+proc traffic::refresh {} {
+    variable stat
+    variable jids
+    variable columns
+    variable wished_connid 
+    variable current_connid
+    variable options
+
+    set w .traffic_stats
+    if {![winfo exists $w]} { return } 
+    set f [$w.sf getframe]
+
+    
+    # clear if connection was changed
+    if {![cequal [lindex $wished_connid 0] $current_connid]} {	
+	clear_table $f
+	set current_connid [lindex $wished_connid 0]
+    }
+            
+    if {!$current_connid} { return }
+
+    # init sum counters
+    array set sum {}
+    foreach col $columns { set sum($col) 0 }
+    
+    # fill the table
+    set row 1
+    foreach jid [lsort -decreasing -command compare $jids($current_connid,jids)] {
+
+	set tag [jid_to_tag $jid]	
+
+	# set first column - jid
+	if {! [winfo exists $f.jid$tag]} { 	    
+	    label $f.jid$tag -text $jid 
+
+	    if {$options(show_nick)} {
+		set nick [roster::itemconfig $current_connid [roster::find_jid $current_connid $jid] -name]
+		if {$nick != ""} {
+		    $f.jid$tag configure -text $nick
+		}
+	    }
+	}
+	grid $f.jid$tag -row $row -column 0 -sticky w
+	
+        set i 1
+	
+	# set other columns - counters
+	foreach col $columns  {
+	    
+	    if {![winfo exists $f.value$i$tag] } { label $f.value$i$tag }
+	    set value $stat($current_connid,$jid,$col)
+
+	    incr sum($col) $value
+	    $f.value$i$tag configure -text [convert_to_hr $value 10]
+	    grid $f.value$i$tag -row $row -column $i -sticky e
+
+    	    incr i
+	}
+	
+	incr row
+    }
+    
+    # add sum
+    if {! [winfo exists $f.sumname]} { label $f.sumname -text [::msgcat::mc "Total"] }
+    grid $f.sumname -row $row -column 0 -sticky w
+
+    set i 1
+    foreach col $columns {
+	if {![winfo exists $f.sumval$i] } { label $f.sumval$i }
+	$f.sumval$i configure -text [convert_to_hr $sum($col) 10]
+	grid $f.sumval$i -row $row -column $i -sticky e	
+	incr i
+    }    
+}
+
+proc traffic::convert_to_hr {value limit} {
+    variable options
+
+    if {!$options(human_readable)} {
+	return $value
+    }
+
+    set cur "" 
+    foreach c {K M G} {
+      if { [expr $value / 1024] > $limit} {
+          set value [expr $value / 1024]
+          set cur $c
+      } else { break }
+    }  
+   return $value$cur
+}
+
+proc traffic::clear_table {f} {
+    
+    set max [expr [string length $f.title] -1]
+    foreach slave [grid slaves $f] {	
+	if { ![cequal [string range $slave 0 $max] $f.title] } {
+	    grid remove $slave
+	    destroy $slave
+	}
+    }
+}
+
+proc traffic::clear_and_refresh {args} {
+
+    set w .traffic_stats
+    if {![winfo exists $w]} { return } 
+    set f [$w.sf getframe]
+
+    clear_table $f
+    refresh
+}
+
+proc traffic::update_connections {type connid} {
+    variable wished_connid
+    
+    set w .traffic_stats
+    if {![winfo exists $w]} { return } 
+    
+    set connections [get_connections] 
+    
+    if { [cequal $type off] && [expr [lsearch $connections $wished_connid] < 0 ] } {
+	set wished_connid "0 None"
+    }
+
+    $w.tools.connection configure -values $connections  -height [expr [llength $connections] + 1]
+
+    if { [cequal $type on] && [cequal $wished_connid "0 None"] } {
+	set wished_connid [list $connid [jlib::connection_jid $connid]]
+    }
+
+    refresh
+}
+
+proc traffic::tick {} {
+    variable timer_id
+    variable timer
+
+    refresh
+    set timer_id [after [expr $timer * 1000] [list [namespace current]::tick]]    
+}
+
+proc traffic::turn_timer {args} {
+    variable timer_state 
+    variable timer_names  
+    variable timer_id  
+    variable timer
+ 
+    set timer_state [expr 1 - $timer_state]
+
+    if {$timer_state}  {
+	set timer_id [after [expr $timer * 1000] [list [namespace current]::tick]]    
+    } else {
+	after cancel $timer_id
+    }
+
+    set w .traffic_stats
+    if {![winfo exists $w]} { return } 
+
+    $w.tools.timer configure -text $timer_names($timer_state)    
+}
+
+# ############################
+# Other functions 
+
+proc traffic::compare {arg1 arg2} {
+    variable stat
+    variable sort_order
+    variable current_connid
+
+    return [expr $stat($current_connid,$arg1,$sort_order) - $stat($current_connid,$arg2,$sort_order)]
+}
+
+proc traffic::sort {tag} {
+    variable sort_order
+    set sort_order $tag
+
+    refresh
+}
+
+proc traffic::save_stat { } {
+    variable names
+    variable columns 
+    variable stat
+    variable current_connid
+    variable jids
+
+    set filename [tk_getSaveFile \
+                      -initialdir ~/.tkabber/]
+    if {$filename != ""} {
+
+	set fd [open $filename w]
+
+	# Header
+	set str {}
+	lappend str "JID"
+	foreach col $columns {lappend str $names($col)}
+	puts $fd [join $str "\t"]
+	
+	# Data
+	foreach jid $jids($current_connid,jids) {
+	    set str {}
+	    lappend str $jid
+	    foreach col $columns {lappend str $stat($current_connid,$jid,$col)}
+	    puts $fd [join $str "\t"]	    	    
+	}	
+	close $fd
+    }
+}
+
+proc traffic::reset {} {
+    variable current_connid
+    variable columns
+    variable jids
+    variable stat
+    
+    if {!$current_connid} {return}
+    
+    if { [MessageDlg .request_reset_traffic -aspect 50000 -icon warning \
+	      -type user -buttons {yes no} -default 1 \
+	      -cancel 1 -message [::msgcat::mc "A you sure you want to reset counters?"]] } {
+	return 
+    }
+
+    # clear stats
+    foreach jid $jids($current_connid,jids) {
+	foreach col $columns  {
+	    unset stat($current_connid,$jid,$col)
+	}	
+	unset jids($current_connid,$jid)
+    }    
+    set jids($current_connid,jids) {}
+
+    # clear table
+    clear_and_refresh
+}
+
+# ############################
+# Register in the main menu
+
+proc traffic::setup_menu {} {
+
+    catch {
+
+	set m [.mainframe getmenu plugins]
+	set ind [$m index end]
+
+	$m insert $ind command -label [::msgcat::mc "Traffic statistics"] \
+	    -command [list [namespace current]::open_window]
+    }
+}
+hook::add finload_hook [namespace current]::traffic::setup_menu
+
+# ##############################################
+# Hooks on connect and disconnect (update GUI)
+
+hook::add connected_hook [list [namespace current]::traffic::update_connections on]
+hook::add disconnected_hook [list [namespace current]::traffic::update_connections off]


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

Added: trunk/tkabber-plugins/traffic/version.txt
===================================================================
--- trunk/tkabber-plugins/traffic/version.txt	                        (rev 0)
+++ trunk/tkabber-plugins/traffic/version.txt	2006-09-16 18:42:43 UTC (rev 717)
@@ -0,0 +1 @@
+0.3


Property changes on: trunk/tkabber-plugins/traffic/version.txt
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list