[Tkabber-dev] r1681 - in trunk/tkabber: . msgs plugins/general plugins/iq plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Feb 23 16:56:14 MSK 2009


Author: sergei
Date: 2009-02-23 16:56:14 +0300 (Mon, 23 Feb 2009)
New Revision: 1681

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/disco.tcl
   trunk/tkabber/joingrdialog.tcl
   trunk/tkabber/login.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/msgs/de.msg
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/general/caps.tcl
   trunk/tkabber/plugins/general/remote.tcl
   trunk/tkabber/plugins/iq/version.tcl
   trunk/tkabber/plugins/roster/cache_categories.tcl
   trunk/tkabber/plugins/roster/conferenceinfo.tcl
   trunk/tkabber/plugins/roster/conferences.tcl
Log:
	* disco.tcl, joingrdialog.tcl, login.tcl, messages.tcl, muc.tcl,
	  plugins/general/caps.tcl, plugins/general/remote.tcl,
	  plugins/iq/version.tcl, plugins/roster/cache_categories.tcl,
	  plugins/roster/conferenceinfo.tcl, plugins/roster/conferences.tcl:
	  Moved part of the Disco functionality to TclXMPP.

	* msgs/de.msg: Updated German translation (thanks to Roger Sondermann).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/ChangeLog	2009-02-23 13:56:14 UTC (rev 1681)
@@ -1,3 +1,13 @@
+2009-02-23  Sergei Golovan  <sgolovan at nes.ru>
+
+	* disco.tcl, joingrdialog.tcl, login.tcl, messages.tcl, muc.tcl,
+	  plugins/general/caps.tcl, plugins/general/remote.tcl,
+	  plugins/iq/version.tcl, plugins/roster/cache_categories.tcl,
+	  plugins/roster/conferenceinfo.tcl, plugins/roster/conferences.tcl:
+	  Moved part of the Disco functionality to TclXMPP.
+
+	* msgs/de.msg: Updated German translation (thanks to Roger Sondermann).
+
 2009-02-20  Sergei Golovan  <sgolovan at nes.ru>
 
 	* presence.tcl: Fixed sending custom presence to a conference.

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/disco.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -2,8 +2,7 @@
 
 ##############################################################################
 
-set ::NS(disco_items) "http://jabber.org/protocol/disco#items"
-set ::NS(disco_info)  "http://jabber.org/protocol/disco#info"
+package require xmpp::disco
 
 option add *JDisco.fill          Black		widgetDefault
 option add *JDisco.featurecolor  MidnightBlue   widgetDefault
@@ -17,10 +16,21 @@
     variable additional_items
 }
 
+proc disco::new {xlib} {
+    variable tokens
+
+    if {![info exists tokens($xlib)]} {
+	set tokens($xlib) \
+	    [::xmpp::disco::new $xlib \
+		    -infocommand [namespace code info_query_get_handler] \
+		    -itemscommand [namespace code items_query_get_handler]]
+    }
+}
+
 ##############################################################################
 
 proc disco::request_items {xlib jid args} {
-    variable disco
+    variable tokens
 
     set node ""
     set handler {}
@@ -34,81 +44,35 @@
 	}
     }
 
-    switch -- $cache {
-	first -
-	only -
-	yes {
-	    if {[info exists disco(items,$xlib,$jid,$node)]} {
-		set items $disco(items,$xlib,$jid,$node)
-		if {$handler != ""} {
-		    eval $handler [list ok $items]
-		}
-		if {$cache != "first"} {
-		    return [list ok $items]
-		}
-	    } elseif {$cache == "only"} {
-		return NO
-	    }
-	}
-    }
-
-    set vars {}
-    if {$node != ""} {
-	lappend vars node $node
-    }
-
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create query \
-				    -xmlns $::NS(disco_items) \
-				    -attrs $vars] \
-	-to $jid \
-	-command [list [namespace current]::parse_items \
-		       $xlib $jid $node $handler]
+    ::xmpp::disco::requestItems $tokens($xlib) $jid \
+	    -node $node \
+	    -cache $cache \
+	    -command [namespace code [list parse_items \
+					   $xlib $jid $node $handler]]
 }
 
-proc disco::parse_items {xlib jid node handler res child} {
-    variable disco
-
-    if {![string equal $res ok]} {
+proc disco::parse_items {xlib jid node handler status items} {
+    if {![string equal $status ok]} {
 	if {$handler != ""} {
-	    eval $handler [list error $child]
+	    eval $handler [list status $items]
 	}
-	hook::run disco_items_hook $xlib $jid $node error $child
+	hook::run disco_items_hook $xlib $jid $node $status $items
 	return
     }
 
-    set items {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
-	switch -- $stag {
-	    item {
-		set ijid  [::xmpp::xml::getAttr $sattrs jid]
-		set inode [::xmpp::xml::getAttr $sattrs node]
-		set name  [::xmpp::xml::getAttr $sattrs name]
-		lappend items [list jid $ijid node $inode name $name]
-		set disco(jidname,$xlib,$ijid,$inode) $name
-	    }
-	}
-    }
-
-    set disco(items,$xlib,$jid,$node) $items
-
     debugmsg disco "ITEMS: [list $items]"
 
     if {$handler != ""} {
 	eval $handler [list ok $items]
     }
-
     hook::run disco_items_hook $xlib $jid $node ok $items
+    return
 }
 
 ##############################################################################
 
 proc disco::request_info {xlib jid args} {
-    variable disco
+    variable tokens
 
     set node ""
     set handler {}
@@ -122,154 +86,50 @@
 	}
     }
 
-    # disco(info,featured_nodes,$xlib,$jid,$node) isn't cached because it
-    # isn't really reported. It's for internal use only.
-    set disco(info,featured_nodes,$xlib,$jid,$node) {}
-
-    switch -- $cache {
-	first -
-	only -
-	yes {
-	    if {[info exists disco(info,identities,$xlib,$jid,$node)] && \
-		    [info exists disco(info,identities,$xlib,$jid,$node)]} {
-		set identities $disco(info,identities,$xlib,$jid,$node)
-		set features   $disco(info,features,$xlib,$jid,$node)
-		set extras     $disco(info,extras,$xlib,$jid,$node)
-		if {$handler != ""} {
-		    eval $handler [list ok $identities $features $extras]
-		}
-		if {$cache != "first"} {
-		    return [list ok $identities $features $extras]
-		}
-	    } elseif {$cache == "only"} {
-		return NO
-	    }
-	}
-    }
-
-    set vars {}
-    if {$node != ""} {
-	lappend vars node $node
-    }
-
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create query \
-			-xmlns $::NS(disco_info) \
-			-attrs $vars] \
-	-to $jid \
-	-command [list [namespace current]::parse_info \
-		       $xlib $jid $node $handler]
+    ::xmpp::disco::requestInfo $tokens($xlib) $jid \
+	    -node $node \
+	    -cache $cache \
+	    -command [namespace code [list parse_info \
+					   $xlib $jid $node $handler]]
 }
 
-proc disco::parse_info {xlib jid node handler res child} {
-    variable disco
+proc disco::parse_info {xlib jid node handler status info} {
     variable additional_nodes
 
-    if {![string equal $res ok]} {
+    if {![string equal $status ok]} {
 	if {$handler != ""} {
-	    eval $handler [list error $child {} {}]
+	    eval $handler [list $status $info {} {}]
 	}
-	hook::run disco_info_hook $xlib $jid $node error $child {} {} {}
+	hook::run disco_info_hook $xlib $jid $node $status $info {} {} {}
 	return
     }
 
-    set identities {}
-    set features {}
-    set extras {}
+    lassign $info identities features extras
     set featured_nodes {}
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
-	switch -- $stag {
-	    identity {
-		lappend identities \
-		    [list category [::xmpp::xml::getAttr $sattrs category] \
-			  name [::xmpp::xml::getAttr $sattrs name] \
-			  type [::xmpp::xml::getAttr $sattrs type]]
-	    }
-	    feature {
-		set var [::xmpp::xml::getAttr $sattrs var]
-		if {$var == ""} {
-		    set var [::xmpp::xml::getAttr $sattrs type]
-		}
-		lappend features [list var $var]
-		if {($node == "") && [info exists additional_nodes($var)]} {
-		    lappend featured_nodes \
-			    [concat [list jid $jid] $additional_nodes($var)]
-		    set inode [::xmpp::xml::getAttr $additional_nodes($var) node]
-		    set iname [::xmpp::xml::getAttr $additional_nodes($var) name]
-		    if {![info exists disco(jidname,$xlib,$jid,$inode)]} {
-			set disco(jidname,$xlib,$jid,$inode) $iname
-		    }
-		}
-	    }
-	    default {
-		lassign [::xmpp::data::findForm [list $ch]] type form
-		if {[string equal $type result]} {
-		    lappend extras [::xmpp::data::parseResult $form]
-		}
-	    }
+    foreach feature $features {
+	if {($node == "") && [info exists additional_nodes($feature)]} {
+	    lappend featured_nodes \
+		    [concat [list jid $jid] $additional_nodes($feature)]
 	}
     }
 
-    set disco(info,identities,$xlib,$jid,$node) $identities
-    set disco(info,features,$xlib,$jid,$node) $features
-    set disco(info,extras,$xlib,$jid,$node) $extras
-    set disco(info,featured_nodes,$xlib,$jid,$node) [lrmdups $featured_nodes]
+    set featured_nodes [lsort -unique $featured_nodes]
 
     debugmsg disco \
 	"INFO: IDENTITIES [list $identities] FEATURES [list $features]\
-	 EXTRAS [list $extras] FEATURED NODES [list [lrmdups $featured_nodes]]"
+	 EXTRAS [list $extras] FEATURED NODES [list $featured_nodes]"
 
     if {$handler != ""} {
 	eval $handler [list ok $identities $features $extras]
     }
     hook::run disco_info_hook $xlib $jid $node ok $identities $features \
-			      $extras [lrmdups $featured_nodes]
+			      $extras $featured_nodes
+    return
 }
 
 ###############################################################################
 
-proc disco::get_jid_name {xlib jid node} {
-    variable disco
-    if {[info exists disco(jidname,$xlib,$jid,$node)]} {
-	return $disco(jidname,$xlib,$jid,$node)
-    } else {
-	return ""
-    }
-}
-
-proc disco::get_jid_identities {xlib jid node} {
-    variable disco
-    if {[info exists disco(info,identities,$xlib,$jid,$node)]} {
-	return $disco(info,identities,$xlib,$jid,$node)
-    } else {
-	return {}
-    }
-}
-
-proc disco::get_jid_features {xlib jid node} {
-    variable disco
-    if {[info exists disco(info,features,$xlib,$jid,$node)]} {
-	return $disco(info,features,$xlib,$jid,$node)
-    } else {
-	return {}
-    }
-}
-
-proc disco::get_jid_items {xlib jid node} {
-    variable disco
-    if {[info exists disco(items,$xlib,$jid,$node)]} {
-	return $disco(items,$xlib,$jid,$node)
-    } else {
-	return {}
-    }
-}
-
-###############################################################################
-
 proc disco::register_featured_node {feature node name} {
     variable additional_nodes
 
@@ -278,123 +138,81 @@
 
 ###############################################################################
 
-proc disco::info_query_get_handler {xlib from child args} {
+proc disco::info_query_get_handler {xlib from node lang} {
     variable supported_nodes
     variable node_handlers
     variable supported_features
     variable feature_handlers
     variable extra_handlers
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-    set node [::xmpp::xml::getAttr $attrs node]
-
-    set lang [::xmpp::xml::getAttr $args -lang en]
-
     if {![string equal $node ""]} {
 	if {![info exists supported_nodes($node)]} {
 	    # Probably temporary node
 	    set res {error cancel not-allowed}
 	    hook::run disco_node_reply_hook \
-		      res info $node $xlib $from $lang $child
+		      res info $node $xlib $from $lang
 	    return $res
 	} else {
 	    # Permanent node
-	    set restags [eval $node_handlers($node) \
-			      [list info $xlib $from $lang $child]]
-	    if {[string equal [lindex $restags 0] error]} {
-		return $restags
-	    } else {
-		set res [::xmpp::xml::create query \
-			     -xmlns $::NS(disco_info) \
-			     -attrs [list node $node] \
-			     -subelements $restags]
-	    }
+	    return [eval $node_handlers($node) \
+			 [list info $xlib $from $lang]]
 	}
     } else {
-	set restags {}
+	set identities [list [list category client \
+				   type     pc \
+				   name     Tkabber]]
 
-	lappend restags [::xmpp::xml::create identity \
-				    -attrs [list category client \
-						 type     pc \
-						 name     Tkabber]]
+	set features [lsort [concat [::xmpp::iq::registered $xlib] \
+				    $supported_features]]
+	set extras {}
 
 	foreach h $extra_handlers {
-	    lappend restags [eval $h [list $xlib $from $lang]]
+	    lappend extras [eval $h [list $xlib $from $lang]]
 	}
 
-	foreach ns [lsort [concat [::xmpp::iq::registered $xlib] \
-				  $supported_features]] {
-	    lappend restags [::xmpp::xml::create feature -attrs [list var $ns]]
-	}
-    
-	set res [::xmpp::xml::create query \
-			-xmlns $::NS(disco_info) \
-			-subelements $restags]
+	return [list result $identities $features $extras]
     }
-    return [list result $res]
 }
 
-::xmpp::iq::register get query $::NS(disco_info) \
-		     [namespace current]::disco::info_query_get_handler
-
 ###############################################################################
 
-proc disco::items_query_get_handler {xlib from child args} {
+proc disco::items_query_get_handler {xlib from node lang} {
     variable supported_nodes
     variable node_handlers
     variable root_nodes
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-    set node [::xmpp::xml::getAttr $attrs node]
-
-    set lang [::xmpp::xml::getAttr $args -lang en]
-
     if {![string equal $node ""]} {
 	if {![info exists supported_nodes($node)]} {
 	    # Probably temporary node
 	    set res {error cancel not-allowed}
 	    hook::run disco_node_reply_hook \
-		      res items $node $xlib $from $lang $child
+		      res items $node $xlib $from $lang
 	    return $res
 	} else {
 	    # Permanent node
-	    set restags [eval $node_handlers($node) \
-			      [list items $xlib $from $lang $child]]
-	    if {[string equal [lindex $restags 0] error]} {
-		return $restags
-	    } else {
-		set res [::xmpp::xml::create query \
-			     -xmlns $::NS(disco_items) \
-			     -attrs [list node $node] \
-			     -subelements $restags]
-	    }
+	    return [eval $node_handlers($node) \
+			 [list items $xlib $from $lang]]
 	}
     } else {
-	set restags {}
+	set items {}
 
 	set myjid [my_jid $xlib $from]
 
 	foreach node $root_nodes {
-	    set vars [list jid $myjid]
+	    set item [list jid $myjid]
 	    if {![string equal $supported_nodes($node) ""]} {
-		lappend vars name [::trans::trans $lang $supported_nodes($node)]
+		lappend item name [::trans::trans $lang $supported_nodes($node)]
 	    }
 	    if {![string equal $node ""]} {
-		lappend vars node $node
+		lappend item node $node
 	    }
-	    lappend restags [::xmpp::xml::create item -attrs $vars]
+	    lappend items $item
 	}
 
-	set res [::xmpp::xml::create query \
-			    -xmlns $::NS(disco_items) \
-			    -subelements $restags]
+	return [list result $items]
     }
-    return [list result $res]
 }
 
-::xmpp::iq::register get query $::NS(disco_items) \
-    [namespace current]::disco::items_query_get_handler
-
 ###############################################################################
 
 proc disco::register_feature {feature {handler ""}} {
@@ -447,33 +265,6 @@
 }
 
 ###############################################################################
-
-proc disco::publish_items {xlib jid node action items args} {
-
-    set command ""
-    foreach {key val} $args {
-	switch -- {
-	    -command { set command $val }
-	}
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create query \
-			-xmlns $::NS(disco#publish) \
-			-attrs [list node $node] \
-			-subelements $items] \
-	-to $jid \
-	-command [list [namespace current]::publish_items_result $command]
-
-}
-
-proc disco::publish_items_result {command res child} {
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-###############################################################################
 # Disco Browser
 
 namespace eval disco::browser {
@@ -498,7 +289,6 @@
 
 proc disco::browser::open_win {xlib jid args} {
     variable winid
-    variable disco
     variable config
     variable curjid
     variable disco_list
@@ -552,7 +342,8 @@
     button $w.navigate.browse -text [::msgcat::mc "Browse"] \
 	-command [list [namespace current]::go $w]
 
-    #bind $w.navigate.entry <Return> [list disco::go $w]
+    bind $w.navigate.entry <Return> [list [namespace current]::go $w]
+    bind $w.navigate.node <Return> [list [namespace current]::go $w]
 
     pack $w.navigate.back $w.navigate.forward $w.navigate.lentry -side left
     pack $w.navigate.browse -side right
@@ -569,7 +360,6 @@
     $sw setwidget $tw
 
     pack $sw -side top -expand yes -fill both
-    set disco(tree,$w) $tw
     $tw bindText <Double-ButtonPress-1> \
 	[list [namespace current]::textaction $w]
     $tw bindText <ButtonPress-3> \
@@ -601,7 +391,7 @@
     variable browser
     variable disco_list
     variable node_list
-    
+
     if {[winfo exists $bw]} {
 	set jid [$bw.navigate.entry.e get]
 	set node [$bw.navigate.node.e get]
@@ -636,7 +426,7 @@
 }
 
 hook::add disco_info_hook \
-    [namespace current]::disco::browser::info_receive
+	  [namespace current]::disco::browser::info_receive
 
 proc disco::browser::draw_info \
      {w xlib jid node res identities features extras featured_nodes} {
@@ -645,15 +435,16 @@
 
     set tw $browser(tree,$w)
 
-    set name [disco::get_jid_name $xlib $jid $node]
-    set tnode [jid_to_tag [list $jid $node]]
     set parent_tag [jid_to_tag [list $jid $node]]
-    set data [list item $xlib $jid $node]
-    if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
-	set nitems 0
+    set tnode [jid_to_tag [list $jid $node]]
+    if {[$tw exists $tnode]} {
+	lassign [$tw itemcget $tnode -data] type _ _ _ name _ _ nitems
     } else {
-	set nitems [llength [disco::get_jid_items $xlib $jid $node]]
+	set type item
+	set name ""
+	set nitems 0
     }
+    set data [list $type $xlib $jid $node $name $identities $features $nitems]
     set desc [item_desc $jid $node $name $nitems]
     set icon ""
 
@@ -666,12 +457,15 @@
 	set desc [::msgcat::mc "Error getting info: %s" \
 		      [error_to_string $identities]]
 	set icon ""
-	
+
 	add_line $tw $parent_tag $tnode $icon $desc $data \
 	    -fill $config(identitycolor)
 
-	remove_old $tw $parent_tag identity [list $tnode]
-	remove_old $tw $parent_tag feature [list $tnode]
+	remove_old $tw $parent_tag identity   [list $tnode]
+	remove_old $tw $parent_tag feature    [list $tnode]
+	remove_old $tw $parent_tag extra      [list $tnode]
+	remove_old $tw $parent_tag item2      [list $tnode]
+	remove_old $tw $parent_tag error_info [list $tnode]
 	reorder_node $tw $parent_tag
 	return
     }
@@ -686,16 +480,16 @@
 	set name     [::xmpp::xml::getAttr $identity name]
 	set category [::xmpp::xml::getAttr $identity category]
 	set type     [::xmpp::xml::getAttr $identity type]
-	set data [list identity $xlib $jid $node $category $type]
+	set data [list identity $xlib $jid $node $category $type $name]
 	set desc "$name ($category/$type)"
 	set icon [item_icon $category $type]
-	
+
 	add_line $tw $parent_tag $tnode $icon $desc $data \
-	    -fill $config(identitycolor)
+		 -fill $config(identitycolor)
     }
 
     set extranodes {}
-    
+
     foreach eform $extras {
 	foreach {etag extra} $eform {
 	    lassign $extra var type label values
@@ -710,53 +504,61 @@
 		set desc "$var: $value"
 	    }
 	    set icon ""
-	
+
 	    add_line $tw $parent_tag $tnode $icon $desc $data \
-		-fill $config(identitycolor)
+		     -fill $config(identitycolor)
 	}
     }
 
     set featurenodes {}
 
     foreach feature $features {
-	set var [::xmpp::xml::getAttr $feature var]
 	set tnode [jid_to_tag "feature $feature $jid $node"]
 	lappend featurenodes $tnode
+
 	set data [list feature $xlib $jid $node $feature $category $type]
-	set desc $var
-	if {[info exists browser(feature_handler_desc,$var)]} {
+	set desc $feature
+	if {[info exists browser(feature_handler_desc,$feature)]} {
 	    catch { array unset tmp }
-	    array set tmp $browser(feature_handler_desc,$var)
+	    array set tmp $browser(feature_handler_desc,$feature)
 	    if {[info exists tmp($category)]} {
-		set desc "$tmp($category) ($var)"
+		set desc "$tmp($category) ($feature)"
 	    } elseif {[info exists tmp(*)]} {
-		set desc "$tmp(*) ($var)"
+		set desc "$tmp(*) ($feature)"
 	    }
 	}
 	set icon ""
 
 	add_line $tw $parent_tag $tnode $icon $desc $data \
-	    -fill $config(featurecolor)
+		 -fill $config(featurecolor)
     }
 
+    set item2nodes {}
+
     # Draw all implicit item nodes, which are not received explicitly
     # (don't overwrite node because it can have different name)
     foreach item $featured_nodes {
 	set ijid [::xmpp::xml::getAttr $item jid]
 	set node [::xmpp::xml::getAttr $item node]
-
 	set name [::xmpp::xml::getAttr $item name]
+
 	set tnode [jid_to_tag [list $ijid $node]]
-	set data [list item $xlib $ijid $node]
-	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
-	    set nitems 0
+	lappend item2nodes $tnode
+
+	if {[$tw exists $tnode]} {
+	    lassign [$tw itemcget $tnode -data] type _ _ _ _ identities features nitems
 	} else {
-	    set nitems [llength [disco::get_jid_items $xlib $ijid $node]]
+	    set type item2
+	    set identities {}
+	    set features {}
+	    set nitems 0
 	}
+	set data [list item2 $xlib $ijid $node $name $identities $features $nitems]
 	set desc [item_desc $ijid $node $name $nitems]
 	set icon ""
 
-	if {![$tw exists $tnode]} {
+	if {![$tw exists $tnode] || \
+		[lindex [$tw itemcget $tnode -data] 0] != "item"} {
 	    add_line $tw $parent_tag $tnode $icon $desc $data \
 		     -fill $config(fill)
 	}
@@ -765,6 +567,7 @@
     remove_old $tw $parent_tag identity $identitynodes
     remove_old $tw $parent_tag extra    $extranodes
     remove_old $tw $parent_tag feature  $featurenodes
+    remove_old $tw $parent_tag item2    $item2nodes
     remove_old $tw $parent_tag error_info {}
     reorder_node $tw $parent_tag
 }
@@ -782,7 +585,7 @@
 }
 
 hook::add disco_items_hook \
-    [namespace current]::disco::browser::items_receive
+	  [namespace current]::disco::browser::items_receive
 
 proc disco::browser::draw_items {w xlib jid node res items} {
     variable browser
@@ -791,67 +594,58 @@
     set tw $browser(tree,$w)
 
     set parent_tag [jid_to_tag [list $jid $node]]
-
-    set name [disco::get_jid_name $xlib $jid $node]
     set tnode [jid_to_tag [list $jid $node]]
-    set data [list item $xlib $jid $node]
-    if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
-	set nitems 0
+
+    if {[$tw exists $tnode]} {
+	lassign [$tw itemcget $tnode -data] type _ _ _ name identities features
     } else {
-	set nitems [llength [disco::get_jid_items $xlib $jid $node]]
+	set type item
+	set name ""
+	set identities {}
+	set features {}
     }
+    set nitems [llength $items]
+    set data [list $type $xlib $jid $node $name $identities $features $nitems]
     set desc [item_desc $jid $node $name $nitems]
     set icon ""
 
     add_line $tw $parent_tag $tnode $icon $desc $data \
-	-fill $config(fill)
+	     -fill $config(fill)
 
     if {$res != "ok"} {
-	# HACK
-	if {[info exists ::disco::disco(info,featured_nodes,$xlib,$jid,$node)] && \
-	    ![lempty $::disco::disco(info,featured_nodes,$xlib,$jid,$node)]} {
-	    set items {}
-	} else {
-	    set tnode [jid_to_tag "error items $jid $node"]
-	    set data [list error_items $xlib $jid]
-	    set desc [::msgcat::mc "Error getting items: %s" \
-				   [error_to_string $items]]
-	    set icon ""
-	
-	    add_line $tw $parent_tag $tnode $icon $desc $data \
-		     -fill $config(fill)
+	set tnode [jid_to_tag "error items $jid $node"]
+	set data [list error_items $xlib $jid]
+	set desc [::msgcat::mc "Error getting items: %s" \
+			       [error_to_string $items]]
+	set icon ""
 
-	    remove_old $tw $parent_tag item [list $tnode]
-	    reorder_node $tw $parent_tag
-	    return
-	}
+	add_line $tw $parent_tag $tnode $icon $desc $data \
+		 -fill $config(fill)
+
+	remove_old $tw $parent_tag item [list $tnode]
+	remove_old $tw $parent_tag error_items [list $tnode]
+	reorder_node $tw $parent_tag
+	return
     }
 
-    # HACK
-    # Don't remove nodes, which are drawn after disco#info query
-    # (if the service's features change then this node list may be
-    # incorrect)
     set itemnodes {}
-    if {[info exists ::disco::disco(info,featured_nodes,$xlib,$jid,$node)]} {
-	foreach item $::disco::disco(info,featured_nodes,$xlib,$jid,$node) {
-	    set ijid [::xmpp::xml::getAttr $item jid]
-	    set inode [::xmpp::xml::getAttr $item node]
-	    lappend itemnodes [jid_to_tag [list $ijid $inode]]
-	}
-    }
 
     foreach item $items {
 	set ijid [::xmpp::xml::getAttr $item jid]
 	set node [::xmpp::xml::getAttr $item node]
-
 	set name [::xmpp::xml::getAttr $item name]
+
 	set tnode [jid_to_tag [list $ijid $node]]
-	set data [list item $xlib $ijid $node]
-	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
-	    set nitems 0
+
+	if {[$tw exists $tnode]} {
+	    lassign [$tw itemcget $tnode -data] type _ _ _ _ identities features nitems
 	} else {
-	    set nitems [llength [disco::get_jid_items $xlib $ijid $node]]
+	    set type item
+	    set identities {}
+	    set features {}
+	    set nitems 0
 	}
+	set data [list item $xlib $ijid $node $name $identities $features $nitems]
 	set desc [item_desc $ijid $node $name $nitems]
 	set icon ""
 
@@ -870,7 +664,6 @@
 }
 
 proc disco::browser::add_line {tw parent node icon desc data args} {
-
     if {[$tw exists $node]} {
 	if {[$tw parent $node] != $parent && [$tw exists $parent] && \
 		$parent != $node} {
@@ -892,10 +685,8 @@
 	eval {$tw insert end root $node -text $desc -open 1 -image $icon \
 		  -data $data} $args
     }
-
 }
 
-
 proc disco::browser::reorder_node {tw node {order {}}} {
     set subnodes [$tw nodes $node]
 
@@ -982,21 +773,21 @@
     set data [$tw itemcget $tnode -data]
     set data2 [lassign $data type]
     switch -- $type {
-	item {
+	item -
+	item2 {
 	    lassign $data2 xlib jid node
 	    goto $bw $jid $node
 	}
 	feature {
 	    lassign $data2 xlib jid node feature category subtype
-	    set var [::xmpp::xml::getAttr $feature var]
 	    debugmsg disco $jid
-	    if {$var != ""} {
-		if {[info exists browser(feature_handler,$var)]} {
-		    if {$browser(feature_handler_node,$var)} {
-			eval $browser(feature_handler,$var) [list $xlib $jid $node \
+	    if {$feature != ""} {
+		if {[info exists browser(feature_handler,$feature)]} {
+		    if {$browser(feature_handler_node,$feature)} {
+			eval $browser(feature_handler,$feature) [list $xlib $jid $node \
 			    -category $category -type $subtype]
 		    } else {
-			eval $browser(feature_handler,$var) [list $xlib $jid \
+			eval $browser(feature_handler,$feature) [list $xlib $jid \
 			    -category $category -type $subtype]
 		    }
 		}
@@ -1016,7 +807,6 @@
 
     set tw $browser(tree,$bw)
     set data [$tw itemcget $tnode -data]
-    set data2 [lassign $data type]
 
     # Parent node category shouldn't impact node action in theory,
     # but sometimes (e.g. when joining MUC group) it's useful.
@@ -1046,7 +836,8 @@
 		-command [list [namespace current]::browser_action browse $bw $tnode]
 	    $m add separator
 	}
-	item {
+	item -
+	item2 {
 	    $m add command -label [::msgcat::mc "Browse"] \
 		-command [list [namespace current]::browser_action browse $bw $tnode]
 	    $m add command -label [::msgcat::mc "Sort items by name"] \
@@ -1077,7 +868,7 @@
 proc disco::browser::clearall {bw} {
     variable browser
     set tw $browser(tree,$bw)
-     
+
     set subnodes [$tw nodes root]
     foreach sn $subnodes {
 	$tw delete $sn
@@ -1089,19 +880,18 @@
     set tw $browser(tree,$bw)
 
     set tparentnode [$tw parent $tnode]
-    
+
     set type [lindex [$tw itemcget $tnode -data] 0]
 
     if {$tparentnode != "root"} {
-	if {$type != "item"} {
+	if {$type != "item" && $type != "item2"} {
 	    set tnode $tparentnode
 	}
 	foreach sn [$tw nodes $tnode] {
 	    $tw delete $sn
 	}
-	lassign [$tw itemcget $tnode -data] type xlib jid node
-	if {$type == "item"} {
-	    set name [disco::get_jid_name $xlib $jid $node]
+	lassign [$tw itemcget $tnode -data] type xlib jid node name
+	if {$type == "item" || $type == "item2"} {
 	    set desc [item_desc $jid $node $name 0]
 	    $tw itemconfigure $tnode -text $desc
 	}
@@ -1119,21 +909,22 @@
 
     switch -glob -- $type/$action {
 	item/browse -
+	item2/browse -
 	feature/browse {
 	    textaction $bw $tnode
 	}
 
-	item/sort {
+	item/sort -
+	item2/sort {
 	    set browser(sort,$bw,$tnode) sort
             set items {}
             foreach child [$tw nodes $tnode] {
 		set data [lassign [$tw itemcget $child -data] type]
 		switch -- $type {
-		    item {
-			lassign $data xlib jid node
-			lappend items \
-			    [list $child \
-				  [disco::get_jid_name $xlib $jid $node]]
+		    item -
+		    item2 {
+			lassign $data xlib jid node name
+			lappend items [list $child $name]
 		    }
 		}
             }
@@ -1148,14 +939,16 @@
             }
 	}
 
-	item/sortjid {
+	item/sortjid -
+	item2/sortjid {
 	    set browser(sort,$bw,$tnode) sortjid
             set items {}
 	    set items_with_nodes {}
             foreach child [$tw nodes $tnode] {
 		set data [lassign [$tw itemcget $child -data] type]
 		switch -- $type {
-		    item {
+		    item -
+		    item2 {
 			lassign $data xlib jid node
 			if {$node != {}} {
 			    lappend items_with_nodes \
@@ -1185,7 +978,6 @@
 
 # TODO
 proc disco::browser::textballoon {bw node} {
-    variable disco
     variable browser
 
     set tw $browser(tree,$bw)
@@ -1211,32 +1003,75 @@
     go $bw
 }
 
-proc disco::browser::get_category_type {t tnode} {
-    foreach child [$t nodes $tnode] {
-	set data [$t itemcget $child -data]
-        set data2 [lassign $data type xlib jid node]
-	if {$type == "identity"} {
-	    return $data2
+proc disco::browser::get_parent_identities {bw tnode} {
+    variable browser
+
+    set t $browser(tree,$bw)
+    return [get_identities $bw [$t parent $tnode]]
+}
+
+proc disco::browser::get_identities {bw tnode} {
+    variable browser
+
+    set t $browser(tree,$bw)
+
+    lassign [$t itemcget $tnode -data] type _ _ _ _ identities
+    switch -- $type {
+	item -
+	item2 {
+	    return $identities
 	}
+	default {
+	    return {}
+	}
     }
-    return {}
 }
 
+proc disco::browser::get_parent_features {bw tnode} {
+    variable browser
+
+    set t $browser(tree,$bw)
+    return [get_features $bw [$t parent $tnode]]
+}
+
+proc disco::browser::get_features {bw tnode} {
+    variable browser
+
+    set t $browser(tree,$bw)
+
+    lassign [$t itemcget $tnode -data] type _ _ _ _ _ features
+    switch -- $type {
+	item -
+	item2 {
+	    return $features
+	}
+	default {
+	    return {}
+	}
+    }
+}
+
 proc disco::browser::draginitcmd {bw t tnode top} {
     set data [$t itemcget $tnode -data]
     set data2 [lassign $data type xlib jid node]
 
-    if {$type == "item"} {
+    if {$type == "item" || $type == "item2"} {
 	if {[set img [$t itemcget $tnode -image]] != ""} {
 	    pack [label $top.l -image $img -padx 0 -pady 0]
 	}
 
-	lassign [get_category_type $t $tnode] category type
+	set identities [get_identities $bw $tnode]
+	if {[llength $identities] > 0} {
+	    lassign [lindex $identities 0] category type
+	}
 
 	if {![info exists category]} {
 	    # Using parent tag to get conference category.
 	    # ??? Which else category could be got from parent?
-	    lassign [get_category_type $t [$t parent $tnode]] category type
+	    set identities [get_identities $bw [$t parent $tnode]]
+	    if {[llength $identities] > 0} {
+		lassign [lindex $identities 0] category type
+	    }
 
 	    if {![info exists category] || ($category != "conference")} {
 		# For other JIDs use heuristics from roster code.
@@ -1286,7 +1121,7 @@
 
     set browser(hist,$bw) [lreplace $browser(hist,$bw) 0 \
 			       [expr {$browser(histpos,$bw) - 1}]]
-    
+
     lvarpush browser(hist,$bw) $jid
     set browser(histpos,$bw) 0
     debugmsg disco $browser(hist,$bw)
@@ -1300,11 +1135,6 @@
 #}
 
 proc disco::browser::register_feature_handler {feature handler args} {
-    eval [list hook::run browser_register_feature_handler_hook \
-	       $feature $handler] $args
-}
-
-proc disco::browser::register_feature_handler1 {feature handler args} {
     variable browser
 
     set node 0
@@ -1324,9 +1154,6 @@
     }
 }
 
-hook::add browser_register_feature_handler_hook \
-	  disco::browser::register_feature_handler1
-
 # Destroy all (global) state assotiated with the given browser window.
 # Intended to be bound to a <Destroy> event handler for browser windows.
 proc disco::browser::destroy_state {bw} {

Modified: trunk/tkabber/joingrdialog.tcl
===================================================================
--- trunk/tkabber/joingrdialog.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/joingrdialog.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -182,19 +182,18 @@
 
 proc joingroup_disco_node_menu_setup {m bw tnode data parentdata} {
     lassign $data type xlib jid node
-    lassign $parentdata ptype pxlib pjid pnode
     switch -- $type {
-	item {
-	    set identities [disco::get_jid_identities $xlib $jid $node]
-	    set pidentities [disco::get_jid_identities $pxlib $pjid $pnode]
+	item -
+	item2 {
+	    set identities [::disco::browser::get_identities $bw $tnode]
 
-	    # JID with resource is not a room JID
-	    if {[::xmpp::jid::resource $jid] != ""} return
-
 	    if {[lempty $identities]} {
-		set identities $pidentities
+		set identities [::disco::browser::get_parent_identities $bw $tnode]
 	    }
 
+	    # JID with resource is not a room JID
+	    if {[::xmpp::jid::resource $jid] != ""} return
+
 	    foreach id $identities {
 		if {[::xmpp::xml::getAttr $id category] == "conference"} {
 		    $m add command -label [::msgcat::mc "Join group..."] \

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/login.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -495,6 +495,8 @@
     set connrjid($xlib) $jid
     set connjid($xlib) $jid
 
+    disco::new $xlib
+
     return $xlib
 }
 

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/messages.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -706,18 +706,18 @@
 proc message::disco_popup_menu {m bw tnode data parentdata} {
     lassign $data type xlib jid node
     switch -- $type {
-	item {
-	    set identities [disco::get_jid_identities $xlib $jid $node]
+	item -
+	item2 {
+	    set identities [disco::browser::get_identities $bw $tnode]
 
 	    foreach id $identities {
 		if {[::xmpp::xml::getAttr $id category] == "client"} {
 		    subject_menu $m $xlib $jid message
-		    break
+		    return
 		}
 	    }
 	}
     }
-
 }
 
 hook::add disco_node_menu_hook message::disco_popup_menu

Modified: trunk/tkabber/msgs/de.msg
===================================================================
--- trunk/tkabber/msgs/de.msg	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/msgs/de.msg	2009-02-23 13:56:14 UTC (rev 1681)
@@ -1,6 +1,6 @@
 
 # German messages file
-# Roger Sondermann 20.02.2009
+# Roger Sondermann 21.02.2009
 
 # .../chats.tcl
 ::msgcat::mcset de "%s has changed nick to %s."                             "%s hat seinen Nicknamen geändert in %s"
@@ -1245,7 +1245,7 @@
 # .../plugins/general/subscribe_gateway.tcl
 ::msgcat::mcset de "Convert"                                                "Konvertieren"
 ::msgcat::mcset de "Convert screenname"                                     "Bildschirm-Namen konvertieren"
-::msgcat::mcset de "Enter screenname of contact you want to add"            "Den Bildschirm-Namen des hinzuzufügenden Kontakts eingeben"
+::msgcat::mcset de "Enter screenname of contact you want to add"            "Den Bildschirm-Namen des hinzuzufügenden Kontaktes eingeben"
 ::msgcat::mcset de "Error while converting screenname: %s."                 "Fehler beim Konvertieren des Bildschirm-Namens: %s"
 ::msgcat::mcset de "I would like to add you to my roster."                  "Ich würde Dich/Sie gerne in meine Kontaktliste aufnehmen.\nI would like to add you to my roster."
 ::msgcat::mcset de "Screenname conversion"                                  "Bildschirm-Namen-Konvertierung"
@@ -1309,20 +1309,20 @@
 ::msgcat::mcset de "%s's activity is unset"                                 "Aktivität für %s ist nicht gesetzt"
 ::msgcat::mcset de "Activity"                                               "Aktivität"
 ::msgcat::mcset de "Activity:"                                              "Aktivität:"
-::msgcat::mcset de "Auto-subscribe to other's user activity"                "Kontakt-Aktivität Anderer automatisch abonnieren"
-::msgcat::mcset de "Auto-subscribe to other's user activity notifications." "Benachrichtigungen über die Kontakt-Aktivitäten Anderer automatisch abonnieren."
-::msgcat::mcset de "Cannot publish empty activity"                          "Unausgefüllte Aktivität kann nicht veröffentlicht werden"
+::msgcat::mcset de "Auto-subscribe to other's user activity"                "Aktivitäten Anderer automatisch abonnieren"
+::msgcat::mcset de "Auto-subscribe to other's user activity notifications." "Benachrichtigungen über die Aktivität Anderer automatisch abonnieren."
+::msgcat::mcset de "Cannot publish empty activity"                          "Nicht ausgefüllte Aktivität kann nicht veröffentlicht werden"
 ::msgcat::mcset de "Error"                                                  "Fehler"
-::msgcat::mcset de "Publish user activity..."                               "Eigene Kontakt-Aktivität veröffentlichen..."
-::msgcat::mcset de "Unpublish user activity"                                "Eigene Kontakt-Aktivität zurückziehen"
-::msgcat::mcset de "Unpublish user activity..."                             "Eigene Kontakt-Aktivität zurückziehen..."
+::msgcat::mcset de "Publish user activity..."                               "Eigene Aktivität veröffentlichen..."
+::msgcat::mcset de "Unpublish user activity"                                "Eigene Aktivität zurückziehen"
+::msgcat::mcset de "Unpublish user activity..."                             "Eigene Aktivität zurückziehen..."
 ::msgcat::mcset de "Subactivity"                                            "Neben-Aktivität"
 ::msgcat::mcset de "Subactivity:"                                           "Neben-Aktivität:"
-::msgcat::mcset de "User activity"                                          "Kontakt-Aktivität"
-::msgcat::mcset de "User activity publishing failed: %s"                    "Veröffentlichen der Kontakt-Aktivität misslungen: %s"
-::msgcat::mcset de "User activity unpublishing failed: %s"                  "Zurückziehen der Kontakt-Aktivität misslungen: %s"
+::msgcat::mcset de "User activity"                                          "Aktivität"
+::msgcat::mcset de "User activity publishing failed: %s"                    "Veröffentlichen der Aktivität misslungen: %s"
+::msgcat::mcset de "User activity unpublishing failed: %s"                  "Zurückziehen der Aktivität misslungen: %s"
 ::msgcat::mcset de "\n\tActivity: %s"                                       "\n\tAktivität: %s"
-::msgcat::mcset de "\n\tUser activity subscription: %s"                   "\n\tAktivitäts-Anmeldung des Kontakts: %s"
+::msgcat::mcset de "\n\tUser activity subscription: %s"                     "\n\tAktivitäts-Anmeldung des Kontaktes: %s"
 
 ::msgcat::mcset de "doing chores"                                           "Haushalt"
 ::msgcat::mcset de "buying groceries"                                         "Lebensmittel kaufen"
@@ -1399,16 +1399,16 @@
 # .../plugins/pep/user_location.tcl
 ::msgcat::mcset de "%s's location changed to %s : %s"                       "%ss Standort geändert in %s : %s"
 ::msgcat::mcset de "%s's location is unset"                                 "%ss Standort ist nicht gesetzt"
-::msgcat::mcset de "Auto-subscribe to other's user location"                "Kontakt-Standort Anderer automatisch abonnieren"
-::msgcat::mcset de "Auto-subscribe to other's user location notifications." "Benachrichtigungen über die Kontakt-Standorte Anderer automatisch abonnieren."
-::msgcat::mcset de "Publish user location..."                               "Eigenen Kontakt-Standort veröffentlichen..."
-::msgcat::mcset de "Unpublish user location"                                "Eigenen Kontakt-Standort zurückziehen"
-::msgcat::mcset de "Unpublish user location..."                             "Eigenen Kontakt-Standort zurückziehen..."
-::msgcat::mcset de "User location"                                          "Kontakt-Standort"
-::msgcat::mcset de "User location publishing failed: %s"                    "Veröffentlichen des Kontakt-Standorts misslungen: %s"
-::msgcat::mcset de "User location unpublishing failed: %s"                  "Zurückziehen des Kontakt-Standorts misslungen: %s"
+::msgcat::mcset de "Auto-subscribe to other's user location"                "Standorte Anderer automatisch abonnieren"
+::msgcat::mcset de "Auto-subscribe to other's user location notifications." "Benachrichtigungen über den Standort Anderer automatisch abonnieren."
+::msgcat::mcset de "Publish user location..."                               "Eigenen Standort veröffentlichen..."
+::msgcat::mcset de "Unpublish user location"                                "Eigenen Standort zurückziehen"
+::msgcat::mcset de "Unpublish user location..."                             "Eigenen Standort zurückziehen..."
+::msgcat::mcset de "User location"                                          "Standort"
+::msgcat::mcset de "User location publishing failed: %s"                    "Veröffentlichen des Standorts misslungen: %s"
+::msgcat::mcset de "User location unpublishing failed: %s"                  "Zurückziehen des Standorts misslungen: %s"
 ::msgcat::mcset de "\n\tLocation: %s : %s"                                  "\n\tStandort: %s : %s"
-::msgcat::mcset de "\n\tUser location subscription: %s"                   "\n\tStandort-Anmeldung des Kontakts: %s"
+::msgcat::mcset de "\n\tUser location subscription: %s"                     "\n\tStandort-Anmeldung des Kontaktes: %s"
 
 ::msgcat::mcset de "Altitude:"                                              "Höhenlage:"
 ::msgcat::mcset de "Area:"                                                  "Gegend:"
@@ -1426,27 +1426,27 @@
 ::msgcat::mcset de "Timestamp:"                                             "Zeitstempel:"
 
 # .../plugins/pep/user_mood.tcl
-::msgcat::mcset de "%s's mood changed to %s"                                "%ss Gemütslage geändert in %s"
-::msgcat::mcset de "%s's mood is unset"                                     "%ss Gemütslage ist nicht gesetzt"
-::msgcat::mcset de "Auto-subscribe to other's user mood"                    "Kontakt-Gemütslage Anderer automatisch abonnieren"
-::msgcat::mcset de "Auto-subscribe to other's user mood notifications."     "Benachrichtigungen über die Kontakt-Gemütslagen Anderer automatisch abonnieren."
-::msgcat::mcset de "Cannot publish empty mood"                              "Unausgefüllte Gemütslage kann nicht veröffentlicht werden"
-::msgcat::mcset de "Mood"                                                   "Gemütslage"
-::msgcat::mcset de "Mood:"                                                  "Gemütslage:"
+::msgcat::mcset de "%s's mood changed to %s"                                "%ss Stimmung geändert in %s"
+::msgcat::mcset de "%s's mood is unset"                                     "%ss Stimmung ist nicht gesetzt"
+::msgcat::mcset de "Auto-subscribe to other's user mood"                    "Stimmungen Anderer automatisch abonnieren"
+::msgcat::mcset de "Auto-subscribe to other's user mood notifications."     "Benachrichtigungen über die Stimmung Anderer automatisch abonnieren."
+::msgcat::mcset de "Cannot publish empty mood"                              "Nicht ausgefüllte Stimmung kann nicht veröffentlicht werden"
+::msgcat::mcset de "Mood"                                                   "Stimmung"
+::msgcat::mcset de "Mood:"                                                  "Stimmung:"
 ::msgcat::mcset de "Publish"                                                "Veröffentlichen"
 ::msgcat::mcset de "Unpublish"                                              "Zurückziehen"
-::msgcat::mcset de "Publish user mood..."                                   "Eigene Kontakt-Gemütslage veröffentlichen..."
-::msgcat::mcset de "Unpublish user mood"                                    "Eigene Kontakt-Gemütslage zurückziehen"
-::msgcat::mcset de "Unpublish user mood..."                                 "Eigene Kontakt-Gemütslage zurückziehen..."
+::msgcat::mcset de "Publish user mood..."                                   "Eigene Stimmung veröffentlichen..."
+::msgcat::mcset de "Unpublish user mood"                                    "Eigene Stimmung zurückziehen"
+::msgcat::mcset de "Unpublish user mood..."                                 "Eigene Stimmung zurückziehen..."
 ::msgcat::mcset de "Publishing is only possible while being online"         "Veröffentlichung nur möglich wenn 'Online'"
 ::msgcat::mcset de "Unpublishing is only possible while being online"       "Zurückziehen nur möglich wenn 'Online'"
 ::msgcat::mcset de "Unsubscribe"                                            "Abmelden/Zurückziehen"
 ::msgcat::mcset de "Use connection:"                                        "Benutze Verbindung:"
-::msgcat::mcset de "User mood"                                              "Kontakt-Gemütslage"
-::msgcat::mcset de "User mood publishing failed: %s"                        "Veröffentlichen der Kontakt-Gemütslage misslungen: %s"
-::msgcat::mcset de "User mood unpublishing failed: %s"                      "Zurückziehen der Kontakt-Gemütslage misslungen: %s"
-::msgcat::mcset de "\n\tMood: %s"                                           "\n\tGemütslage: %s"
-::msgcat::mcset de "\n\tUser mood subscription: %s"                       "\n\tGemütslagen-Anmeldung des Kontakts: %s"
+::msgcat::mcset de "User mood"                                              "Stimmung"
+::msgcat::mcset de "User mood publishing failed: %s"                        "Veröffentlichen der Stimmung misslungen: %s"
+::msgcat::mcset de "User mood unpublishing failed: %s"                      "Zurückziehen der Stimmung misslungen: %s"
+::msgcat::mcset de "\n\tMood: %s"                                           "\n\tStimmung: %s"
+::msgcat::mcset de "\n\tUser mood subscription: %s"                         "\n\tStimmungs-Anmeldung des Kontaktes: %s"
 
 ::msgcat::mcset de "afraid"                                                 "ängstlich"
 ::msgcat::mcset de "amazed"                                                 "erstaunt"
@@ -1515,26 +1515,26 @@
 ::msgcat::mcset de "%s's tune is unset"                                     "%ss Musik ist nicht gesetzt"
 ::msgcat::mcset de "%s's tune has stopped playing"                          "%ss Musik wurde angehalten"
 ::msgcat::mcset de "Artist:"                                                "Interpret:"
-::msgcat::mcset de "Auto-subscribe to other's user tune"                    "Kontakt-Musik Anderer automatisch abonnieren"
-::msgcat::mcset de "Auto-subscribe to other's user tune notifications."     "Benachrichtigungen über die Kontakt-Musik Anderer automatisch abonnieren."
+::msgcat::mcset de "Auto-subscribe to other's user tune"                    "Musik Anderer automatisch abonnieren"
+::msgcat::mcset de "Auto-subscribe to other's user tune notifications."     "Benachrichtigungen über die Musik Anderer automatisch abonnieren."
 ::msgcat::mcset de "Length:"                                                "Länge:"
 ::msgcat::mcset de "Publish \"playback stopped\" instead"                   "Stattdessen \"Wiedergabe angehalten\" veröffentlichen"
-::msgcat::mcset de "Publish user tune..."                                   "Eigene Kontakt-Musik veröffentlichen..."
-::msgcat::mcset de "Unpublish user tune"                                    "Eigene Kontakt-Musik zurückziehen"
-::msgcat::mcset de "Unpublish user tune..."                                 "Eigene Kontakt-Musik zurückziehen..."
+::msgcat::mcset de "Publish user tune..."                                   "Eigene Musik veröffentlichen..."
+::msgcat::mcset de "Unpublish user tune"                                    "Eigene Musik zurückziehen"
+::msgcat::mcset de "Unpublish user tune..."                                 "Eigene Musik zurückziehen..."
 ::msgcat::mcset de "Rating:"                                                "Bewertung:"
 ::msgcat::mcset de "Source:"                                                "Quelle:"
 ::msgcat::mcset de "Track:"                                                 "Index:"
 ::msgcat::mcset de "URI:"                                                   "URI:"
-::msgcat::mcset de "User tune"                                              "Kontakt-Musik"
-::msgcat::mcset de "User tune publishing failed: %s"                        "Veröffentlichen der Kontakt-Musik misslungen: %s"
-::msgcat::mcset de "User tune unpublishing failed: %s"                      "Zurückziehen der Kontakt-Musik misslungen: %s"
+::msgcat::mcset de "User tune"                                              "Musik"
+::msgcat::mcset de "User tune publishing failed: %s"                        "Veröffentlichen der Musik misslungen: %s"
+::msgcat::mcset de "User tune unpublishing failed: %s"                      "Zurückziehen der Musik misslungen: %s"
 ::msgcat::mcset de "\n\tTune: %s - %s"                                      "\n\tMusik: %s - %s"
-::msgcat::mcset de "\n\tUser tune subscription: %s"                       "\n\tMusik-Anmeldung des Kontakts: %s"
+::msgcat::mcset de "\n\tUser tune subscription: %s"                         "\n\tMusik-Anmeldung des Kontaktes: %s"
 
 # .../plugins/richtext/emoticons.tcl
 ::msgcat::mcset de "Handle ROTFL/LOL smileys -- those like :))) -- by \"consuming\" all that parens and rendering the whole word with appropriate icon." "ROTFL/LOL Smileys, wie z. B. :-))), derart behandeln, daß alle Paare entfernt werden und das Ganze mit dem zugehörigen Icon dargestellt wird."
-::msgcat::mcset de "Handling of \"emoticons\". Emoticons (also known as \"smileys\") are small pictures resembling a human face used to represent user's emotion. They are typed in as special mnemonics like :) or can be inserted using menu." "Optionen für die Behandlung von Emoticons.\n'Emoticons' (auch als 'Smileys' bekannt) sind kleine, einem menschlichen Gesicht gleichende Bilder, die die Emotionen des Kontakts repräsentieren sollen. Sie werden mit einer speziellen Mnemonik wie z. B. :-) oder über ein Menü eingegeben."
+::msgcat::mcset de "Handling of \"emoticons\". Emoticons (also known as \"smileys\") are small pictures resembling a human face used to represent user's emotion. They are typed in as special mnemonics like :) or can be inserted using menu." "Optionen für die Behandlung von Emoticons.\n'Emoticons' (auch als 'Smileys' bekannt) sind kleine, einem menschlichen Gesicht gleichende Bilder, die die Emotionen des Kontaktes repräsentieren sollen. Sie werden mit einer speziellen Mnemonik wie z. B. :-) oder über ein Menü eingegeben."
 ::msgcat::mcset de "Show images for emoticons."                             "Bilder für Emoticons anzeigen."
 ::msgcat::mcset de "Tkabber emoticons theme. To make new theme visible for Tkabber put it to some subdirectory of %s." "Tkabber Emoticon-Thema. Um es für Tkabber sichtbar zu machen, muß es in einem Unterordner von %s platziert werden."
 ::msgcat::mcset de "Use only whole words for emoticons."                    "Nur ganze Wörter als Emoticons benutzen."

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/muc.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -170,33 +170,31 @@
 
 proc muc::disco_node_menu_setup {m bw tnode data parentdata} {
     lassign $data type xlib jid node
-    lassign $parentdata ptype pxlib pjid pnode
     switch -- $type {
-	item {
-	    set identities [disco::get_jid_identities $xlib $jid $node]
-	    set pidentities [disco::get_jid_identities $pxlib $pjid $pnode]
+	item -
+	item2 {
+	    set identities [disco::browser::get_identities $bw $tnode]
 
-	    set features [disco::get_jid_features $xlib $jid $node]
-	    set pfeatures [disco::get_jid_features $pxlib $pjid $pnode]
+	    if {[lempty $identities]} {
+		set identities [disco::browser::get_parent_identities $bw $tnode]
+	    }
 
+	    set features [disco::browser::get_features $bw $tnode]
+
+	    if {[lempty $features]} {
+		set features [disco::browser::get_parent_features $bw $tnode]
+	    }
+
 	    # JID with resource is not a room JID
 	    if {[::xmpp::jid::stripResource $jid] != $jid} return
 
 	    # A room must have non-empty node
 	    if {[::xmpp::jid::node $jid] == ""} return
 
-	    if {[lempty $identities]} {
-		set identities $pidentities
-	    }
-
-	    if {[lempty $features]} {
-		set features $pfeatures
-	    }
-
 	    foreach id $identities {
 		if {[::xmpp::xml::getAttr $id category] == "conference"} {
 		    foreach f $features {
-			if {[::xmpp::xml::getAttr $f var] == $::NS(muc)} {
+			if {$f == $::NS(muc)} {
 			    add_muc_menu_items $m [chat::chatid $xlib $jid] end
 			    return
 			}
@@ -1408,25 +1406,21 @@
 proc muc::request_negotiation {xlib group} {
     variable muc_compatible
 
-    set muc_compatible($group) 0
+    # It's almost impossible to find MUC-incompatible room now, so the default
+    # value is 1
+    set muc_compatible($group) 1
 
     disco::request_info $xlib [::xmpp::jid::server $group] \
 	-cache yes \
 	-command [list muc::recv_negotiation1 $xlib $group]
 }
 
-
 proc muc::recv_negotiation1 {xlib group res identities features extras} {
     variable muc_compatible
 
-    if {[string equal $res ok]} {
-	foreach f $features {
-	    set var [::xmpp::xml::getAttr $f var]
-	    if {$var == $::NS(muc)} {
-		set muc_compatible($group) 1
-		return
-	    }
-	}
+    if {[string equal $res ok] && [lsearch -exact $features $::NS(muc)] >= 0} {
+	set muc_compatible($group) 1
+	return
     }
 
     disco::request_info $xlib $group \
@@ -1437,19 +1431,14 @@
 proc muc::recv_negotiation2 {group res identities features extras} {
     variable muc_compatible
 
-    if {[string equal $res ok]} {
-	foreach f $features {
-	    set var [::xmpp::xml::getAttr $f var]
-	    if {$var == $::NS(muc)} {
-		set muc_compatible($group) 1
-		return
-	    }
-	}
+    if {[string equal $res ok] && [lsearch -exact $features $::NS(muc)] >= 0} {
+	set muc_compatible($group) 1
+	return
     }
+
     set muc_compatible($group) 0
 }
 
-
 proc muc::is_compatible {group} {
     variable muc_compatible
 
@@ -1741,7 +1730,7 @@
 ###############################################################################
 
 
-proc muc::disco_reply {type xlib from lang child} {
+proc muc::disco_reply {type xlib from lang} {
     variable options
 
     if {!$options(report_muc_rooms)} {
@@ -1750,18 +1739,17 @@
 
     switch -- $type {
 	info {
-	    return {}
+	    return [list result {}]
 	}
 	items {
 	    set res {}
 	    foreach chatid [lfilter chat::is_groupchat [chat::opened $xlib]] {
 		set group [chat::get_jid $chatid]
 		if {[is_compatible $group]} {
-		    lappend res [::xmpp::xml::create item \
-				     -attrs [list jid $group]]
+		    lappend res [list jid $group]
 		}
 	    }
-	    return $res
+	    return [list result $res]
 	}
     }
 }

Modified: trunk/tkabber/plugins/general/caps.tcl
===================================================================
--- trunk/tkabber/plugins/general/caps.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/general/caps.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -101,38 +101,20 @@
     return [base64::encode $binhash]
 }
 
-proc caps::info_to_hash {info hash} {
-    set identities {}
+proc caps::info_to_hash {identities features extras hash} {
+    set identities2 {}
     set features {}
     set extras {}
 
-    ::xmpp::xml::split $info tag xmlns attrs cdata subels
-
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-	switch -- $stag {
-	    identity {
-		set category [::xmpp::xml::getAttr $sattrs category]
-		set type [::xmpp::xml::getAttr $sattrs type]
-		set lang [::xmpp::xml::getAttr $sattrs xml:lang]
-		set name [::xmpp::xml::getAttr $sattrs name]
-		lappend identities $category/$type/$lang/$name
-	    }
-	    feature {
-		set var [::xmpp::xml::getAttr $sattrs var]
-		if {![string equal $var ""]} {
-		    lappend features $var
-		}
-	    }
-	    x {
-		lassign [::xmpp::data::findForm [list $subel]] type form
-		if {[string equal $type result]} {
-		    lappend extras [::xmpp::data::parseResult $form]
-		}
-	    }
-	}
+    foreach identity $identities {
+	set category [::xmpp::xml::getAttr $identity category]
+	set type [::xmpp::xml::getAttr $identity type]
+	set lang [::xmpp::xml::getAttr $identity xml:lang]
+	set name [::xmpp::xml::getAttr $identity name]
+	lappend identities2 $category/$type/$lang/$name
     }
-    return [hash $identities $features $extras $hash]
+
+    return [hash $identities2 $features $extras $hash]
 }
 
 proc caps::get_presence_x {varname xlib status} {
@@ -142,14 +124,12 @@
 
     if {!$options(enable)} return
 
-    lassign [disco::info_query_get_handler \
-		    $xlib "" en \
-		    [::xmpp::xml::create query -xmlns $::NS(disco_info)]] \
-	    status xml
+    lassign [disco::info_query_get_handler $xlib "" "" en] \
+	    status identities features extras
 
     if {![string equal $status result]} return
 
-    set ver [info_to_hash $xml $options(hash)]
+    set ver [info_to_hash $identities $features $extras $options(hash)]
     if {[string equal $ver ""]} return
 
     lappend var [::xmpp::xml::create c \
@@ -165,21 +145,14 @@
 
 hook::add presence_xlist_hook [namespace current]::caps::get_presence_x
 
-proc caps::disco_reply {varname type node xlib from lang child} {
+proc caps::disco_reply {varname type node xlib from lang} {
     variable caps_node
     upvar 2 $varname res
 
     if {$type != "info" || $node != $caps_node} return
 
-    set res [disco::info_query_get_handler \
-		    $xlib "" en \
-		    [::xmpp::xml::create query -xmlns $::NS(disco_info)]]
+    set res [disco::info_query_get_handler $xlib "" "" en]
 
-    if {[string equal [lindex $res 0] result]} {
-	::xmpp::xml::split [lindex $res 1] tag xmlns attrs cdata subels
-	lappend attrs node $caps_node
-	set res [list result [::xmpp::xml::merge $tag $xmlns $attrs $cdata $subels]]
-    }
     return stop
 }
 

Modified: trunk/tkabber/plugins/general/remote.tcl
===================================================================
--- trunk/tkabber/plugins/general/remote.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/general/remote.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -67,38 +67,34 @@
     lappend commands(nodes) $node
 
     ::disco::register_subnode $node \
-	[namespace current]::common_command_infoitems_handler $name
+	    [namespace code [list common_command_infoitems_handler $node]] \
+	    $name
 }
 
-proc ::remote::common_command_infoitems_handler {type xlib from lang xmllist} {
+proc ::remote::common_command_infoitems_handler {node type xlib from lang} {
     variable commands
 
     if {![allow_remote_control $xlib $from]} {
 	return {error cancel not-allowed}
     }
 
-    ::xmpp::xml::split $xmllist tag xmlns attrs cdata subels
-    set node [::xmpp::xml::getAttr $attrs node]
-
-    if {![cequal $node ""] && [info exists commands(command,$node)]} {
-	if {[cequal $type info]} {
+    if {![string equal $node ""] && [info exists commands(command,$node)]} {
+	if {[string equal $type info]} {
 	    return \
-		[list [::xmpp::xml::create identity \
-			   -attrs [list category automation \
-				        type command-node \
-				        name [::trans::trans $lang \
+		[list result [list [list category automation \
+				         type command-node \
+				         name [::trans::trans $lang \
 						    $commands(name,$node)]]] \
-		      [::xmpp::xml::create feature \
-			   -attrs [list var $::NS(commands)]]]
+			     [list $::NS(commands)] {}]
 	} else {
-	    return {}
+	    return [list result {}]
 	}
     } else {
 	return {error modify bad-request}
     }
 }
 
-proc ::remote::commands_list_handler {type xlib from lang xmllist} {
+proc ::remote::commands_list_handler {type xlib from lang} {
     variable commands
 
     if {![allow_remote_control $xlib $from]} {
@@ -111,23 +107,21 @@
 	items {
 	    set items {}
 	    foreach node $commands(nodes) {
-		lappend items [::xmpp::xml::create item \
-				   -attrs [list jid $myjid \
-					        node $node \
-					        name [::trans::trans $lang \
-							  $commands(name,$node)]]]
+		lappend items [list jid $myjid \
+				    node $node \
+				    name [::trans::trans $lang \
+						    $commands(name,$node)]]
 	    }
-	    return $items
+	    return [list result $items]
 	}
 	info {
-	    return [list [::xmpp::xml::create identity \
-			      -attrs [list category automation \
-					   type command-list \
-					   name [::trans::trans $lang \
-						     "Remote control"]]]]
+	    return [list result [list [list category automation \
+					    type command-list \
+					    name [::trans::trans $lang \
+							"Remote control"]]] \
+				{} {}]
 	}
     }
-    return {}
 }
 
 ::disco::register_feature $::NS(commands)

Modified: trunk/tkabber/plugins/iq/version.tcl
===================================================================
--- trunk/tkabber/plugins/iq/version.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/iq/version.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -196,7 +196,7 @@
 		       field [list os_version "" "" [list $os_version]]
     }
 
-    return [::xmpp::data::resultForm $fields]
+    return $fields
 }
 
 hook::add postload_hook \

Modified: trunk/tkabber/plugins/roster/cache_categories.tcl
===================================================================
--- trunk/tkabber/plugins/roster/cache_categories.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/roster/cache_categories.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -52,38 +52,29 @@
 
     lappend requested_categories($xlib) $server
 
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create query \
-			-xmlns $::NS(disco_info)] \
-	-to $server \
-	-command [list [namespace current]::parse_requested_categories $xlib $server]
+    ::disco::request_info $xlib $server \
+	    -cache yes \
+	    -command [namespace code [list parse_requested_categories \
+					   $xlib $server]]
 }
 
 ##############################################################################
 
-proc cache_categories::parse_requested_categories {xlib server status xml} {
+proc cache_categories::parse_requested_categories \
+     {xlib server status identities features extras} {
     variable category_and_subtype_list
 
     if {$status != "ok"} return
 
-    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+    foreach identity $identities {
+	set category [::xmpp::xml::getAttr $identity category]
+	set type     [::xmpp::xml::getAttr $identity type]
 
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-	switch -- $stag {
-	    identity {
-		set category [::xmpp::xml::getAttr $sattrs category]
-		set type     [::xmpp::xml::getAttr $sattrs type]
+	roster::override_category_and_subtype $xlib $server $category $type
+	lappend category_and_subtype_list $server [list $category $type]
 
-		roster::override_category_and_subtype $xlib $server \
-						      $category $type
-		lappend category_and_subtype_list \
-			$server [list $category $type]
-
-		::redraw_roster
-		break
-	    }
-	}
+	::redraw_roster
+	break
     }
 }
 

Modified: trunk/tkabber/plugins/roster/conferenceinfo.tcl
===================================================================
--- trunk/tkabber/plugins/roster/conferenceinfo.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/roster/conferenceinfo.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -97,10 +97,7 @@
 			$data(error_disco,$jid) == "" || \
 			$sec - $data(time_disco,$jid) >= $options(err_interval) * 60} {
 
-		    ::xmpp::sendIQ $xlib get \
-			-query [::xmpp::xml::create query \
-					-xmlns $::NS(disco_items)] \
-			-to $jid \
+		    ::disco::request_items $xlib $jid \
 			-command [list [namespace current]::receive $jid disco]
 		}
 	    }
@@ -126,26 +123,27 @@
 	return
     }
 
-    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+    switch -- $mech {
+	browse {
+	    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
 
-    foreach item $subels {
-	::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
-	set category [::xmpp::xml::getAttr $sattrs category]
-	set name [::xmpp::xml::getAttr $sattrs name]
-	set node [::xmpp::xml::getAttr $sattrs node]
-	switch -- $mech {
-	    browse {
+	    foreach item $subels {
+		::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
+		set category [::xmpp::xml::getAttr $sattrs category]
+		set name [::xmpp::xml::getAttr $sattrs name]
 		if {$stag == "user" || ($stag == "item" && $category == "user")} {
 		    if {$name != ""} {
 			lappend data(users_browse,$jid) $name
 		    }
 		}
 	    }
-	    disco {
-		if {$stag == "item"} {
-		    if {$name != "" && $node == ""} {
-			lappend data(users_disco,$jid) $name
-		    }
+	}
+	disco {
+	    foreach item $xml {
+		set name [::xmpp::xml::getAttr $item name]
+		set node [::xmpp::xml::getAttr $item node]
+		if {$name != "" && $node == ""} {
+		    lappend data(users_disco,$jid) $name
 		}
 	    }
 	}

Modified: trunk/tkabber/plugins/roster/conferences.tcl
===================================================================
--- trunk/tkabber/plugins/roster/conferences.tcl	2009-02-23 13:52:58 UTC (rev 1680)
+++ trunk/tkabber/plugins/roster/conferences.tcl	2009-02-23 13:56:14 UTC (rev 1681)
@@ -916,17 +916,17 @@
     lassign $data type xlib jid node
     lassign $parentdata ptype pxlib pjid pnode
     switch -- $type {
-	item {
-	    set identities [disco::get_jid_identities $xlib $jid $node]
-	    set pidentities [disco::get_jid_identities $pxlib $pjid $pnode]
+	item -
+	item2 {
+	    set identities [::disco::browser::get_identities $bw $tnode]
 
+	    if {[lempty $identities]} {
+		set identities [::disco::browser::get_parent_identities $bw $tnode]
+	    }
+
 	    # JID with resource is not a room JID
 	    if {[::xmpp::jid::resource $jid] != ""} return
 
-	    if {[lempty $identities]} {
-		set identities $pidentities
-	    }
-
 	    foreach id $identities {
 		if {[::xmpp::xml::getAttr $id category] == "conference"} {
 		    $m add command -label [::msgcat::mc "Add conference to roster..."] \



More information about the Tkabber-dev mailing list