[Tkabber-dev] r1388 - in trunk/tkabber: . plugins/iq

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Mar 7 12:57:59 MSK 2008


Author: sergei
Date: 2008-03-07 12:57:59 +0300 (Fri, 07 Mar 2008)
New Revision: 1388

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/disco.tcl
   trunk/tkabber/plugins/iq/version.tcl
Log:
	* disco.tcl: Added registering extras to include XEP-0128 forms into
	  disco#info replies.

	* plugins/iq/version.tcl: Implemented reporting Tkabber version in
	  disco#info replies (XEP-0232).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-03-07 09:20:21 UTC (rev 1387)
+++ trunk/tkabber/ChangeLog	2008-03-07 09:57:59 UTC (rev 1388)
@@ -3,6 +3,12 @@
 	* plugins/chat/draw_xhtml_message.tcl: Fixed a bug with xhtml_symb tag
 	  which was introduced when removing global font variable.
 
+	* disco.tcl: Added registering extras to include XEP-0128 forms into
+	  disco#info replies.
+
+	* plugins/iq/version.tcl: Implemented reporting Tkabber version in
+	  disco#info replies (XEP-0232).
+
 2008-03-06  Sergei Golovan  <sgolovan at nes.ru>
 
 	* disco.tcl: Added new hook disco_node_reply_hook to allow answering

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2008-03-07 09:20:21 UTC (rev 1387)
+++ trunk/tkabber/disco.tcl	2008-03-07 09:57:59 UTC (rev 1388)
@@ -211,9 +211,9 @@
 		}
 	    }
 	    default {
-		if {[jlib::wrapper:getattr $vars1 xmlns] == "jabber:x:data" && \
+		if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(data) && \
 			[jlib::wrapper:getattr $vars1 type] == "result"} {
-		    set extras [data::parse_xdata_results $children1]
+		    set extras [concat $extras [data::parse_xdata_results $children1]]
 		}
 	    }
 	}
@@ -279,6 +279,7 @@
     variable node_handlers
     variable supported_features
     variable feature_handlers
+    variable extra_handlers
 
     jlib::wrapper:splitxml $child tag vars isempty chdata children
     set node [jlib::wrapper:getattr $vars node]
@@ -292,7 +293,8 @@
 	    return $res
 	} else {
 	    # Permanent node
-	    set restags [$node_handlers($node) info $connid $from $lang $child]
+	    set restags [eval $node_handlers($node) \
+			      [list info $connid $from $lang $child]]
 	    if {[string equal [lindex $restags 0] error]} {
 		return $restags
 	    } else {
@@ -306,9 +308,13 @@
 
 	lappend restags [jlib::wrapper:createtag identity \
 			     -vars [list category client \
-					 type pc \
-					 name Tkabber]]
+					 type     pc \
+					 name     Tkabber]]
 
+	foreach h $extra_handlers {
+	    lappend restags [eval $h [list $connid $from $lang]]
+	}
+
 	foreach ns [lsort [concat $::iq::supported_ns $supported_features]] {
 	    lappend restags [jlib::wrapper:createtag feature \
 				 -vars [list var $ns]]
@@ -343,7 +349,8 @@
 	    return $res
 	} else {
 	    # Permanent node
-	    set restags [$node_handlers($node) items $connid $from $lang $child]
+	    set restags [eval $node_handlers($node) \
+			      [list items $connid $from $lang $child]]
 	    if {[string equal [lindex $restags 0] error]} {
 		return $restags
 	    } else {
@@ -424,6 +431,14 @@
 
 ###############################################################################
 
+proc disco::register_extra {handler} {
+    variable extra_handlers
+
+    lappend extra_handlers $handler
+}
+
+###############################################################################
+
 proc disco::publish_items {jid node action items args} {
 
     set command ""
@@ -688,7 +703,11 @@
 	lappend extranodes $tnode
 	set data [list extra $var $connid $jid $node]
 	set value [join $values ", "]
-	set desc "$label ($var): $value"
+	if {$label != ""} {
+	    set desc "$label ($var): $value"
+	} else {
+	    set desc "$var: $value"
+	}
 	set icon ""
 	
 	add_line $tw $parent_tag $tnode $icon $desc $data \

Modified: trunk/tkabber/plugins/iq/version.tcl
===================================================================
--- trunk/tkabber/plugins/iq/version.tcl	2008-03-07 09:20:21 UTC (rev 1387)
+++ trunk/tkabber/plugins/iq/version.tcl	2008-03-07 09:57:59 UTC (rev 1388)
@@ -99,27 +99,27 @@
 
     switch -- $tcl_platform(os) {
 	"Win32s" {
-	    return "Windows 3.1"
+	    return {Windows 3.1}
 	}
 	"Windows 95" {
 	    switch -- $tcl_platform(osVersion) {
-		4.0  { return "Windows 95" }
-		4.10 { return "Windows 98" }
-		4.90 { return "Windows ME" }
-		default { return "$tcl_platform(os) $tcl_platform(osVersion)" }
+		4.0  { return {Windows 95} }
+		4.10 { return {Windows 98} }
+		4.90 { return {Windows ME} }
+		default { return [list $tcl_platform(os) $tcl_platform(osVersion)] }
 	    }
 	}
 	"Windows NT" {
 	    switch -- $tcl_platform(osVersion) {
-		5.0 { return "Windows 2000"  }
-		5.1 { return "Windows XP"    }
-		5.2 { return "Windows 2003"  }
-		6.0 { return "Windows Vista" }
-		default { return "$tcl_platform(os) $tcl_platform(osVersion)" }
+		5.0 { return {Windows 2000}  }
+		5.1 { return {Windows XP}    }
+		5.2 { return {Windows 2003}  }
+		6.0 { return {Windows Vista} }
+		default { return [list $tcl_platform(os) $tcl_platform(osVersion)] }
 	    }
 	}
 	default {
-	    return "$tcl_platform(os) $tcl_platform(osVersion)"
+	    return [list $tcl_platform(os) $tcl_platform(osVersion)]
 	}
     }
 }
@@ -145,7 +145,7 @@
 		set os "[guess_linux_distribution] $tcl_platform(osVersion)"
 	    }
 	    Win* {
-		set os [guess_windows_version]
+		set os [join [guess_windows_version]]
 	    }
 	    default {
 		set os "$tcl_platform(os) $tcl_platform(osVersion)"
@@ -165,3 +165,56 @@
 iq::register_handler get query jabber:iq:version \
     [namespace current]::iq_version
 
+proc disco_extra_version {connid from lang} {
+    global tkabber_version toolkit_version tcl_platform
+    variable options
+
+    set fields \
+	[list [jlib::wrapper:createtag field \
+		   -vars [list var  FORM_TYPE \
+			       type hidden] \
+		   -subtags [list [jlib::wrapper:createtag value -chdata \
+				       urn:xmpp:dataforms:softwareinfo]]] \
+	      [jlib::wrapper:createtag field \
+		   -vars [list var software] \
+		   -subtags [list [jlib::wrapper:createtag value \
+				       -chdata Tkabber]]] \
+	      [jlib::wrapper:createtag field \
+		   -vars [list var software_version] \
+		   -subtags [list [jlib::wrapper:createtag value -chdata \
+				   "$tkabber_version ($toolkit_version)"]]]]
+
+    if {$options(reply_iq_os_version)} {
+	switch -glob -- $tcl_platform(os) {
+	    Linux {
+		set os [guess_linux_distribution]
+		set os_version $tcl_platform(osVersion)
+	    }
+	    Win* {
+		lassign [guess_windows_version] os os_version
+	    }
+	    default {
+		set os $tcl_platform(os)
+		set os_version $tcl_platform(osVersion)
+	    }
+	}
+    
+	lappend fields \
+		[jlib::wrapper:createtag field \
+		     -vars [list var os] \
+		     -subtags [list [jlib::wrapper:createtag value \
+				         -chdata $os]]] \
+		[jlib::wrapper:createtag field \
+		     -vars [list var os_version] \
+		     -subtags [list [jlib::wrapper:createtag value \
+					 -chdata $os_version]]]
+    }
+
+    return [jlib::wrapper:createtag x \
+		-vars [list xmlns $::NS(data) \
+			    type  result] \
+		-subtags $fields]
+}
+
+hook::add postload_hook \
+	[list disco::register_extra [namespace current]::disco_extra_version]



More information about the Tkabber-dev mailing list