[Tkabber-dev] r1654 - in trunk/tkabber: . ifacetk

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Feb 14 17:33:36 MSK 2009


Author: sergei
Date: 2009-02-14 17:33:36 +0300 (Sat, 14 Feb 2009)
New Revision: 1654

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iroster.tcl
Log:
	* ifacetk/iroster.tcl: Fixed showing metacontacts in case when some of
	  its members are online and the others are offline. Put metacontact
	  in all groups of its members. Fixed creating JID popup menu on
	  metacontacts. Added processing of radiobuttons to popup menus.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-02-14 12:20:33 UTC (rev 1653)
+++ trunk/tkabber/ChangeLog	2009-02-14 14:33:36 UTC (rev 1654)
@@ -5,6 +5,11 @@
 
 	* custom.tcl: Use random filename for temporal customization store.
 
+	* ifacetk/iroster.tcl: Fixed showing metacontacts in case when some of
+	  its members are online and the others are offline. Put metacontact
+	  in all groups of its members. Fixed creating JID popup menu on
+	  metacontacts. Added processing of radiobuttons to popup menus.
+
 2009-02-13  Sergei Golovan  <sgolovan at nes.ru>
 
 	* muc.tcl: Move focus and scroll down to 'add new JID' field in MUC

Modified: trunk/tkabber/ifacetk/iroster.tcl
===================================================================
--- trunk/tkabber/ifacetk/iroster.tcl	2009-02-14 12:20:33 UTC (rev 1653)
+++ trunk/tkabber/ifacetk/iroster.tcl	2009-02-14 14:33:36 UTC (rev 1654)
@@ -312,12 +312,14 @@
 	# Preparing metacontacts.
 	array unset metajids
 	array unset metagroups
+	array unset groups_from_meta
 	set metacontacted {}
-	if {[namespace exists ::plugins::metacontacts]} {
+	if {[llength [info procs ::plugins::metacontacts::*]] > 0} {
 	    foreach tag [::plugins::metacontacts::get_all_tags $xlib] {
 		set jids [::plugins::metacontacts::get_jids $xlib $tag]
 		set metagroups($tag) {}
 
+		set cgroups {}
 		foreach jid $jids {
 		    # Skip JID if it doesn't match filter pattern or if it
 		    # isn't a JID of use
@@ -325,6 +327,9 @@
 		    if {$isuser == ""} {
 			set isuser 1
 		    }
+		    if {$isuser} {
+			set cgroups [concat $cgroups [::roster::itemconfig $xlib $jid -group]]
+		    }
 		    if {$isuser && [filter_match $xlib $jid]} {
 			lappend metagroups($tag) $jid
 			lappend metacontacted $jid
@@ -359,6 +364,11 @@
 		}
 
 		lappend metajids($mjid) $tag
+		if {![info exists groups_from_meta($mjid)]} {
+		    set groups_from_meta($mjid) $cgroups
+		} else {
+		    set groups_from_meta($mjid) [concat $groups_from_meta($mjid) $cgroups]
+		}
 	    }
 
 	    foreach jid [array names metajids] {
@@ -414,6 +424,11 @@
 
 	    # Add JID groups to a groups list
 	    set jid_groups [::roster::itemconfig $xlib $jid -group]
+
+	    if {[info exists groups_from_meta($jid)]} {
+		set jid_groups [concat $jid_groups $groups_from_meta($jid)]
+	    }
+
 	    if {[llength $jid_groups] > 0} {
 		foreach group $jid_groups {
 		    if {$options(nested)} {
@@ -613,41 +628,65 @@
 			}
 		    }
 
+		    set condition [expr {!$show_only_online || $show_offline_users || \
+					 $roster(show_offline,$gid) || \
+					 ($options(use_filter) && $options(filter) != "")}]
 		    set cjid [list $xlib $jid]
-		    if {!$show_only_online || $show_offline_users || $roster(show_offline,$gid) || \
-			    ($options(use_filter) && $options(filter) != "") || \
-			    ![info exists useronline($jid)] || $useronline($jid)} {
+		    if {$condition || ![info exists useronline($jid)] || $useronline($jid)} {
 
 			if {[info exists metajids($jid)]} {
 
 			    set jids {}
 			    foreach tag $metajids($jid) {
-				set jids [concat $jids $metagroups($tag)]
+				foreach subjid $metagroups($tag) {
+				    # Metacontact members are necessarily users, so don't
+				    # check for this
+				    if {![info exists jstat($subjid)]} {
+					set jstat($subjid) [get_user_status $xlib $subjid]
+				    }
+				    if {$jstat($subjid) != "unavailable"} {
+					set useronline($subjid) 1
+				    } else {
+					set useronline($subjid) 0
+				    }
+				    if {$condition || $useronline($subjid)} {
+					lappend jids $subjid
+				    }
+				}
 			    }
 			    set jids [lsort -unique $jids]
 			    set numjids [llength $jids]
-			    if {$config(subitemtype) & 1} {
-				append label " ($numjids)"
-			    }
-			    addline .roster metajid $label $cjid $gid \
-					    [list $xlib $metajids($jid)] $indent $jids \
-					    [get_jid_icon $xlib $jid] \
-					    [get_jid_foreground $xlib $jid]
 
-			    if {!$roster(metacollapsed,[list $xlib $metajids($jid)])} {
-				set subjid_labels {}
-				foreach subjid $jids {
-				    lappend subjid_labels \
-					    [list $subjid [::roster::get_label $xlib $subjid]]
+			    if {$numjids > 1} {
+				# Draw as a metacontact
+				if {$config(subitemtype) & 1} {
+				    append label " ($numjids)"
 				}
-				set subjid_labels [lsort -index 1 -dictionary $subjid_labels]
-			    
-				foreach subjid_label $subjid_labels {
-				    lassign $subjid_label subjid label
+				addline .roster metajid $label $cjid $gid \
+					        [list $xlib $metajids($jid)] $indent $jids \
+					        [get_jid_icon $xlib $jid] \
+					        [get_jid_foreground $xlib $jid]
 
-				    draw_jid $xlib $subjid $label $gid \
-					     [list $xlib $metajids($jid)] $indent jstat
+				if {!$roster(metacollapsed,[list $xlib $metajids($jid)])} {
+				    set subjid_labels {}
+				    foreach subjid $jids {
+					lappend subjid_labels \
+					        [list $subjid [::roster::get_label $xlib $subjid]]
+				    }
+				    set subjid_labels [lsort -index 1 -dictionary $subjid_labels]
+				    foreach subjid_label $subjid_labels {
+					lassign $subjid_label subjid label
+					draw_jid $xlib $subjid $label $gid \
+					         [list $xlib $metajids($jid)] $indent jstat
+				    }
 				}
+			    } else {
+				# Draw as an ordinary contact using a hack with indent
+				# which allows to add metajid tag. The hack depends on
+				# metajid indent equals to group indent
+				draw_jid $xlib $jid $label $gid \
+					 [list $xlib $metajids($jid)] \
+					 [expr {$indent - 1}] jstat
 			    }
 			} else {
 			    draw_jid $xlib $jid $label $gid {} $indent jstat
@@ -1745,81 +1784,123 @@
     set m1 $prefix[jid_to_tag [lindex $jids 0]]$suffix
 
     for {set i 0} {[$m1 index $i] == $i} {incr i} {
-	if {[catch { $m1 entrycget $i -label } label]} {
-	    $m add separator
-	} elseif {![catch { $m1 entrycget $i -menu } menu]} {
-	    set suffix2 [join [lrange [split $menu .] 2 end] .]
-	    set suffix3 [lindex [split $menu .] end]
-	    set m2 [menu $m.$suffix3 -tearoff 0]
-	    $m add cascade -label $label -menu $m2
-	    add_menu_submenu $m2 $prefix .$suffix2 $jids
-	} elseif {![catch { $m1 entrycget $i -variable } var]} {
-	    # Can't distinguish checkbuttons and radiobuttons
-	    # Works only for checkbuttons
-	    add_checkbutton_submenu $m $prefix $suffix $i $label $jids
-	} else {
-	    add_command_submenu $m $prefix $suffix $i $label $jids
+	switch -- [$m1 type $i] {
+	    separator {
+		$m add separator
+	    }
+	    cascade {
+		set label [$m1 entrycget $i -label]
+		set menu [$m1 entrycget $i -menu]
+		set suffix2 [join [lrange [split $menu .] 2 end] .]
+		set suffix3 [lindex [split $menu .] end]
+		set m2 [menu $m.$suffix3 -tearoff 0]
+		$m add cascade -label $label -menu $m2
+		add_menu_submenu $m2 $prefix .$suffix2 $jids
+	    }
+	    checkbutton {
+		set label [$m1 entrycget $i -label]
+		add_checkbutton_submenu $m $prefix $suffix $i $label $jids
+	    }
+	    radiobutton {
+		set label [$m1 entrycget $i -label]
+		add_radiobutton_submenu $m $prefix $suffix $i $label $jids
+	    }
+	    command {
+		set label [$m1 entrycget $i -label]
+		add_command_submenu $m $prefix $suffix $i $label $jids
+	    }
 	}
     }
 }
 
 ###############################################################################
 
-proc roster::add_command_submenu {m prefix suffix i label jids} {
-    set command_list {}
+proc roster::get_popup_command_list {m prefix suffix label jids args} {
+    set command_list1 {}
+    set command_list2 {}
     foreach jid $jids {
+	set bjid [::xmpp::jid::stripResource $jid]
 	set m1 $prefix[jid_to_tag $jid]$suffix
-	if {![catch {set idx [$m1 index $label]}] && $idx != "none"} {
-	    set command [$m1 entrycget $idx -command]
-	    if {[lsearch -exact $command_list $command] < 0} {
-		lappend command_list $command
+	if {![catch {$m1 index $label} idx] && $idx != "none"} {
+	    set command {}
+	    foreach opt $args {
+		lappend command [$m1 entrycget $idx $opt]
 	    }
+	    lappend command_list1 [list $jid $command]
+	    lappend command_list2 [list $bjid $command]
 	}
     }
+
+    set command_list2 [lsort -unique $command_list2]
+    set command_list3 [lsort -unique -index 0 $command_list2]
+
+    if {[llength $command_list2] != [llength $command_list3]} {
+	return $command_list1
+    } else {
+	return $command_list2
+    }
+}
+
+proc roster::add_command_submenu {m prefix suffix i label jids} {
+    set command_list [get_popup_command_list $m $prefix $suffix $label $jids \
+					     -command]
     if {[llength $command_list] > 1} {
 	set m2 [menu $m.$i -tearoff 0]
 	$m add cascade -label $label -menu $m2
-	foreach jid $jids {
-	    set m1 $prefix[jid_to_tag $jid]$suffix
-	    if {![catch {set idx [$m1 index $label]}] && $idx != "none"} {
-		set command [$m1 entrycget $idx -command]
-		$m2 add command -label $jid \
-		    -command [string map [list $m1 $m2] $command]
-	    }
+
+	foreach jid_command $command_list {
+	    lassign $jid_command jid command
+	    $m2 add command -label $jid -command [lindex $command 0]
 	}
     } else {
-	$m add command -label $label -command [lindex $command_list 0]
+	$m add command -label $label \
+		       -command [lindex [lindex [lindex $command_list 0] 1] 0]
     }
 }
 
-###############################################################################
+proc roster::add_checkbutton_submenu {m prefix suffix i label jids} {
+    set command_list [get_popup_command_list $m $prefix $suffix $label $jids \
+					     -variable -command]
 
-proc roster::add_checkbutton_submenu {m prefix suffix i label jids} {
-    set command_list {}
-    foreach jid $jids {
-	set m1 $prefix[jid_to_tag $jid]$suffix
-	if {![catch {set idx [$m1 index $label]}] && $idx != "none"} {
-	    set var [$m1 entrycget $idx -variable]
-	    set command [$m1 entrycget $idx -command]
-	    if {[lsearch -exact $command_list [list $var $command]] < 0} {
-		lappend command_list [list $var $command]
-	    }
+    if {[llength $command_list] > 1} {
+	set m2 [menu $m.$i -tearoff 0]
+	$m add cascade -label $label -menu $m2
+
+	foreach jid_command $command_list {
+	    lassign $jid_command jid command
+	    $m2 add checkbutton -label $jid \
+				-variable [lindex $command 0] \
+				-command [lindex $command 1]
 	}
+    } else {
+	lassign [lindex [lindex $command_list 0] 1] var command
+	$m add checkbutton -label $label \
+			   -variable $var \
+			   -command $command
     }
+}
+
+proc roster::add_radiobutton_submenu {m prefix suffix i label jids} {
+    set command_list [get_popup_command_list $m $prefix $suffix $label $jids \
+					     -value -variable -command]
+
     if {[llength $command_list] > 1} {
 	set m2 [menu $m.$i -tearoff 0]
 	$m add cascade -label $label -menu $m2
-	foreach jid $jids {
-	    set m1 $prefix[jid_to_tag $jid]$suffix
-	    if {![catch {set idx [$m1 index $label]}] && $idx != "none"} {
-		set var [$m1 entrycget $idx -variable]
-		set command [$m1 entrycget $idx -command]
-		$m2 add checkbutton -label $jid -variable $var -command $command
-	    }
+
+	foreach jid_command $command_list {
+	    lassign $jid_command jid command
+	    $m2 add radiobutton -label $jid \
+				-value [lindex $command 0] \
+				-variable [lindex $command 1] \
+				-command [lindex $command 2]
 	}
     } else {
-	lassign [lindex $command_list 0] var command
-	$m add checkbutton -label $label -variable $var -command $command
+	lassign [lindex [lindex $command_list 0] 1] value var command
+	$m add radiobutton -label $label \
+			   -value $value \
+			   -variable $var \
+			   -command $command
     }
 }
 



More information about the Tkabber-dev mailing list