[Tkabber-dev] r1402 - in trunk/tkabber: . plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Apr 21 23:49:30 MSD 2008


Author: sergei
Date: 2008-04-21 23:49:29 +0400 (Mon, 21 Apr 2008)
New Revision: 1402

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/datagathering.tcl
   trunk/tkabber/disco.tcl
   trunk/tkabber/plugins/general/caps.tcl
   trunk/tkabber/plugins/general/remote.tcl
Log:
	* datagathering.tcl: Added variable type to parsed jabber:x:data form
	  output.

	* plugins/general/remote.tcl: Adjusted to account for variable types
	  in jabber:x:data forms.

	* disco.tcl: Changed semantics of extras argument in disco_info_hook
	  to a list of forms instead of a flat list of all variables.

	* plugins/general/caps.tcl: Fixed identity support (added name and
	  xml:lang processing). Added extras (additional jabber:x:data forms)
	  support.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-04-16 17:09:01 UTC (rev 1401)
+++ trunk/tkabber/ChangeLog	2008-04-21 19:49:29 UTC (rev 1402)
@@ -1,3 +1,18 @@
+2008-04-21  Sergei Golovan  <sgolovan at nes.ru>
+
+	* datagathering.tcl: Added variable type to parsed jabber:x:data form
+	  output.
+
+	* plugins/general/remote.tcl: Adjusted to account for variable types
+	  in jabber:x:data forms.
+
+	* disco.tcl: Changed semantics of extras argument in disco_info_hook
+	  to a list of forms instead of a flat list of all variables.
+
+	* plugins/general/caps.tcl: Fixed identity support (added name and
+	  xml:lang processing). Added extras (additional jabber:x:data forms)
+	  support.
+
 2008-04-16  Sergei Golovan  <sgolovan at nes.ru>
 
 	* privacy.tcl: Changed "no default list" and "no active list"

Modified: trunk/tkabber/datagathering.tcl
===================================================================
--- trunk/tkabber/datagathering.tcl	2008-04-16 17:09:01 UTC (rev 1401)
+++ trunk/tkabber/datagathering.tcl	2008-04-21 19:49:29 UTC (rev 1402)
@@ -262,7 +262,7 @@
 		lappend values $chdata1
 	    }
 	}
-	lappend result [list $var $label $values]
+	lappend result [list $var $type $label $values]
     }
     return $result
 }

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2008-04-16 17:09:01 UTC (rev 1401)
+++ trunk/tkabber/disco.tcl	2008-04-21 19:49:29 UTC (rev 1402)
@@ -213,7 +213,7 @@
 	    default {
 		if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(data) && \
 			[jlib::wrapper:getattr $vars1 type] == "result"} {
-		    set extras [concat $extras [data::parse_xdata_results $children1]]
+		    lappend extras [data::parse_xdata_results $children1 -hidden 1]
 		}
 	    }
 	}
@@ -697,21 +697,24 @@
 
     set extranodes {}
     
-    foreach extra $extras {
-	lassign $extra var label values
-	set tnode [jid_to_tag "extra $var $jid $node"]
-	lappend extranodes $tnode
-	set data [list extra $var $connid $jid $node]
-	set value [join $values ", "]
-	if {$label != ""} {
-	    set desc "$label ($var): $value"
-	} else {
-	    set desc "$var: $value"
+    foreach eform $extras {
+	foreach extra $eform {
+	    lassign $extra var type label values
+	    if {$type == "hidden"} continue
+	    set tnode [jid_to_tag "extra $var $jid $node"]
+	    lappend extranodes $tnode
+	    set data [list extra $var $connid $jid $node]
+	    set value [join $values ", "]
+	    if {$label != ""} {
+		set desc "$label ($var): $value"
+	    } else {
+		set desc "$var: $value"
+	    }
+	    set icon ""
+	
+	    add_line $tw $parent_tag $tnode $icon $desc $data \
+		-fill $config(identitycolor)
 	}
-	set icon ""
-	
-	add_line $tw $parent_tag $tnode $icon $desc $data \
-	    -fill $config(identitycolor)
     }
 
     set featurenodes {}

Modified: trunk/tkabber/plugins/general/caps.tcl
===================================================================
--- trunk/tkabber/plugins/general/caps.tcl	2008-04-16 17:09:01 UTC (rev 1401)
+++ trunk/tkabber/plugins/general/caps.tcl	2008-04-21 19:49:29 UTC (rev 1402)
@@ -28,7 +28,7 @@
 	-group Caps -type options -values {md5 MD5 sha-1 SHA-1}
 }
 
-proc caps::hash {identities features hash} {
+proc caps::hash {identities features extras hash} {
 
     set binidentities {}
     foreach id $identities {
@@ -40,8 +40,31 @@
 	lappend binfeatures [encoding convertto utf-8 $fe]
     }
 
+    set binextra {}
+    foreach eform $extras {
+	set bineform {}
+	foreach extra $eform {
+	    lassign $extra var type label values
+	    switch -- $var/$type {
+		FORM_TYPE/hidden {
+		    set form_type [encoding convertto utf-8 [lindex $values 0]]
+		}
+		default {
+		    lappend bineform [encoding convertto utf-8 [linsert $values 0 $var]]
+		}
+	    }
+	}
+	lappend binextra [linsert [lsort -ascii -index 0 $bineform] 0 $form_type]
+    }
+
+    set binextra1 {}
+    foreach b [lsort -ascii -index 0 $binextra] {
+	set binextra1 [concat $binextra1 [join $b "<"]]
+    }
+
     set binstr [join [concat [lsort -ascii $binidentities] \
-			     [lsort -ascii $binfeatures]] "<"]
+			     [lsort -ascii $binfeatures] \
+			     $binextra1] "<"]
 
     if {[string equal $binstr ""]} {
 	return ""
@@ -71,6 +94,7 @@
 proc caps::info_to_hash {child hash} {
     set identities {}
     set features {}
+    set extras {}
 
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
@@ -80,9 +104,9 @@
 	    identity {
 		set category [jlib::wrapper:getattr $vars1 category]
 		set type [jlib::wrapper:getattr $vars1 type]
-		if {![string equal $category ""] && ![string equal $type ""]} {
-		    lappend identities $category/$type
-		}
+		set lang [jlib::wrapper:getattr $vars1 xml:lang]
+		set name [jlib::wrapper:getattr $vars1 name]
+		lappend identities $category/$type/$lang/$name
 	    }
 	    feature {
 		set var [jlib::wrapper:getattr $vars1 var]
@@ -90,9 +114,15 @@
 		    lappend features $var
 		}
 	    }
+	    x {
+		if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(data) && \
+			[jlib::wrapper:getattr $vars1 type] == "result"} {
+		    lappend extras [data::parse_xdata_results $children1 -hidden 1]
+		}
+	    }
 	}
     }
-    return [hash $identities $features $hash]
+    return [hash $identities $features $extras $hash]
 }
 
 proc caps::get_presence_x {varname connid status} {
@@ -209,7 +239,7 @@
 	    lappend fes $var
 	}
     }
-    if {![string equal [hash $ids $fes $htype($connid,$jid)] \
+    if {![string equal [hash $ids $fes $extras $htype($connid,$jid)] \
 		       $hver($connid,$jid)]} {
 	return
     }

Modified: trunk/tkabber/plugins/general/remote.tcl
===================================================================
--- trunk/tkabber/plugins/general/remote.tcl	2008-04-16 17:09:01 UTC (rev 1401)
+++ trunk/tkabber/plugins/general/remote.tcl	2008-04-21 19:49:29 UTC (rev 1402)
@@ -366,7 +366,7 @@
 	}
 
 	foreach field [::data::parse_xdata_results $children -hidden 1] {
-	    lassign $field var label values
+	    lassign $field var type label values
 	    if {[cequal $var FORM_TYPE]} {
 		if {![cequal [lindex $values 0] $form_type]} {
 		    return [::remote::get_error modify bad-request bad-payload]



More information about the Tkabber-dev mailing list