[Tkabber-dev] r1776 - in trunk/tkabber: . ifacetk plugins/pep

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Apr 5 19:58:14 MSD 2009


Author: sergei
Date: 2009-04-05 19:58:14 +0400 (Sun, 05 Apr 2009)
New Revision: 1776

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iroster.tcl
   trunk/tkabber/pep.tcl
   trunk/tkabber/plugins/pep/user_activity.tcl
   trunk/tkabber/plugins/pep/user_location.tcl
   trunk/tkabber/plugins/pep/user_mood.tcl
   trunk/tkabber/plugins/pep/user_tune.tcl
   trunk/tkabber/pubsub.tcl
Log:
	* ifacetk/iroster.tcl: Removed unused curuser variable.

	* pubsub.tcl, pep.tcl: Moved interface part of pubsub and PEP modules
	  to TclXMPP.

	* plugins/pep/user_activity.tcl, plugins/pep/user_location.tcl,
	  plugins/pep/user_mood.tcl, plugins/pep/user_tune.tcl: Adapted to PEP
	  module from TclXMPP.

	* pubsub.tcl: Started to implement user interface to pubsub. So far
	  added two menu items to Disco browser nodes.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/ChangeLog	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1,3 +1,17 @@
+2009-04-05  Sergei Golovan  <sgolovan at nes.ru>
+
+	* ifacetk/iroster.tcl: Removed unused curuser variable.
+
+	* pubsub.tcl, pep.tcl: Moved interface part of pubsub and PEP modules
+	  to TclXMPP.
+
+	* plugins/pep/user_activity.tcl, plugins/pep/user_location.tcl,
+	  plugins/pep/user_mood.tcl, plugins/pep/user_tune.tcl: Adapted to PEP
+	  module from TclXMPP.
+
+	* pubsub.tcl: Started to implement user interface to pubsub. So far
+	  added two menu items to Disco browser nodes.
+
 2009-04-02  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/comm.tcl, tkabber-remote.tcl: Made errors from a
@@ -34,7 +48,7 @@
 
 	* msgs/de.msg: Updated German translation (thanks to Roger Sondermann).
 
-	* proxy.tcl: Moved wrapped geturl to ::http namespace and adopted it to
+	* proxy.tcl: Moved wrapped geturl to ::http namespace and adapted it to
 	  work with HTTPS through a proxy server. The technique uses pconnect
 	  package, therefore it can't be proposed to http upstream as is.
 

Modified: trunk/tkabber/ifacetk/iroster.tcl
===================================================================
--- trunk/tkabber/ifacetk/iroster.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/ifacetk/iroster.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1721,10 +1721,7 @@
 ###############################################################################
 
 proc roster::popup_menu {id jids} {
-    global curuser
-
     lassign $id xlib jid
-    set curuser $jid
 
     lassign [::roster::get_category_and_subtype $xlib $jid] category subtype
 

Modified: trunk/tkabber/pep.tcl
===================================================================
--- trunk/tkabber/pep.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/pep.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1,6 +1,8 @@
 # $Id$
 # Personal eventing via pubsub XEP-0163
 
+package require xmpp::pep
+
 namespace eval pep {
 
     custom::defgroup Plugins \
@@ -13,127 +15,6 @@
 }
 
 ##########################################################################
-#
-# PEP Creating a node (5)
-# -access_model (open, presence (default), roster, whitelist)
-# -roster_groups_allowed (roster group list if access is roster)
-
-proc pep::create_node {xlib node args} {
-    variable ns
-
-    debugmsg pep [info level 0]
-
-    set command ""
-    set access "presence"
-    set groups {}
-
-    if {$node == ""} {
-	return -code error "pep::create_node: node must not be empty"
-    }
-
-    set service [connection_bare_jid $xlib]
-
-    eval [list pubsub::create_node $xlib $service $node] $args
-}
-
-##########################################################################
-#
-# Publish item to PEP node "node" (8)
-# payload is a list of xml tags
-# node must not be empty
-# itemid may be empty
-
-proc pep::publish_item {xlib node itemid args} {
-
-    debugmsg pep [info level 0]
-
-    set command ""
-
-    if {$node == ""} {
-	return -code error "pep::publish_item: node must not be empty"
-    }
-
-    set service [connection_bare_jid $xlib]
-
-    eval [list pubsub::publish_item $xlib $service $node $itemid] $args
-}
-
-##########################################################################
-#
-# Delete item from PEP node "node"
-# node must not be empty
-# itemid must not be empty
-
-proc pep::delete_item {xlib node itemid args} {
-
-    debugmsg pep [info level 0]
-
-    set command ""
-
-    if {$node == ""} {
-	return -code error "pep::delete_item: node must not be empty"
-    }
-
-    if {$itemid == ""} {
-	return -code error "pep::delete_item: Item ID must not be empty"
-    }
-
-    set service [connection_bare_jid $xlib]
-
-    eval [list pubsub::delete_item $xlib $service $node $itemid] $args
-}
-
-##########################################################################
-#
-# Subscribe to PEP node "node" at bare JID "to" (5.2)
-# node must not be empty
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-
-proc pep::subscribe {xlib to node args} {
-
-    debugmsg pep [info level 0]
-
-    if {$node == ""} {
-	return -code error "pep::subscribe error: node must not be empty"
-    }
-
-    eval [list pubsub::subscribe $xlib $to $node] $args
-}
-
-##########################################################################
-#
-# Unsubscribe from PEP node "node" at bare JID "to" (undocumented?!)
-# node must not be empty
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-
-proc pep::unsubscribe {xlib to node args} {
-
-    debugmsg pep [info level 0]
-
-    set command ""
-
-    if {$node == ""} {
-	return -code error "pep::unsubscribe error: node must not be empty"
-    }
-
-    eval [list pubsub::unsubscribe $xlib $to $node] $args
-}
-
-##########################################################################
 # Returns a name of a submenu (of menu $m) for PEP commands to perform on
 # the roster item for a user with JID $jid.
 # This command automatically creates this submenu if needed.

Modified: trunk/tkabber/plugins/pep/user_activity.tcl
===================================================================
--- trunk/tkabber/plugins/pep/user_activity.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/plugins/pep/user_activity.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1,6 +1,8 @@
 # $Id$
 # Implementation of XEP-0107 "User activity"
 
+package require xmpp::pep
+
 namespace eval activity {
     variable node http://jabber.org/protocol/activity
     variable substatus
@@ -186,8 +188,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::subscribe_result $xlib $to]
-    pep::subscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::subscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-subscribe
 }
 
@@ -197,8 +198,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::unsubscribe_result $xlib $to]
-    pep::unsubscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::unsubscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-unsubscribe
 }
 
@@ -415,7 +415,7 @@
 	lappend content [::xmpp::xml::create text -cdata $text]
     }
 
-    set cmd [list pep::publish_item $xlib $node activity \
+    set cmd [list ::xmpp::pep::publishItem $xlib $node activity \
 		  -payload [list [::xmpp::xml::create activity \
 				      -xmlns $node \
 				      -subelements $content]]]
@@ -437,7 +437,7 @@
 	}
     }
 
-    set cmd [list pep::delete_item $xlib $node activity \
+    set cmd [list ::xmpp::pep::deleteItem $xlib $node activity \
 		  -notify true]
 
     if {$callback != ""} {

Modified: trunk/tkabber/plugins/pep/user_location.tcl
===================================================================
--- trunk/tkabber/plugins/pep/user_location.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/plugins/pep/user_location.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1,6 +1,8 @@
 # $Id$
 # Implementation of XEP-0080 "User Location"
 
+package require xmpp::pep
+
 namespace eval geoloc {
     variable node http://jabber.org/protocol/geoloc
     variable substatus
@@ -98,8 +100,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::subscribe_result $xlib $to]
-    pep::subscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::subscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-subscribe
 }
 
@@ -109,8 +110,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::unsubscribe_result $xlib $to]
-    pep::unsubscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::unsubscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-unsubscribe
 }
 
@@ -294,7 +294,7 @@
 	}
     }
 
-    set cmd [list pep::publish_item $xlib $node geoloc \
+    set cmd [list ::xmpp::pep::publishItem $xlib $node geoloc \
 		  -payload [list [::xmpp::xml::create geoloc \
 					    -xmlns $node \
 					    -subelements $content]]]
@@ -316,7 +316,7 @@
 	}
     }
 
-    set cmd [list pep::delete_item $xlib $node geoloc \
+    set cmd [list ::xmpp::pep::deleteItem $xlib $node geoloc \
 		  -notify true]
 
     if {$callback != ""} {

Modified: trunk/tkabber/plugins/pep/user_mood.tcl
===================================================================
--- trunk/tkabber/plugins/pep/user_mood.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/plugins/pep/user_mood.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -2,6 +2,8 @@
 # Implementation of XEP-0107 "User mood"
 # Based on Version 1.1 (2007-06-04).
 
+package require xmpp::pep
+
 namespace eval mood {
     variable node http://jabber.org/protocol/mood
     variable substatus
@@ -146,8 +148,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::subscribe_result $xlib $to]
-    pep::subscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::subscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-subscribe
 }
 
@@ -157,8 +158,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::unsubscribe_result $xlib $to]
-    pep::unsubscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::unsubscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-unsubscribe
 }
 
@@ -352,7 +352,7 @@
 	lappend content [::xmpp::xml::create text -cdata $text]
     }
 
-    set cmd [list pep::publish_item $xlib $node mood \
+    set cmd [list ::xmpp::pep::publishItem $xlib $node mood \
 		  -payload [list [::xmpp::xml::create mood \
 					    -xmlns $node \
 					    -subelements $content]]]
@@ -374,7 +374,7 @@
 	}
     }
 
-    set cmd [list pep::delete_item $xlib $node mood \
+    set cmd [list ::xmpp::pep::deleteItem $xlib $node mood \
 		  -notify true]
 
     if {$callback != ""} {

Modified: trunk/tkabber/plugins/pep/user_tune.tcl
===================================================================
--- trunk/tkabber/plugins/pep/user_tune.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/plugins/pep/user_tune.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -1,6 +1,8 @@
 # $Id$
 # Implementation of XEP-0118 "User Tune"
 
+package require xmpp::pep
+
 namespace eval tune {
     variable node http://jabber.org/protocol/tune
     variable substatus
@@ -94,8 +96,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::subscribe_result $xlib $to]
-    pep::subscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::subscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-subscribe
 }
 
@@ -105,8 +106,7 @@
 
     set to [::xmpp::jid::stripResource $jid]
     set cmd [linsert $args 0 [namespace current]::unsubscribe_result $xlib $to]
-    pep::unsubscribe $xlib $to $node \
-	    -command $cmd
+    ::xmpp::pep::unsubscribe $xlib $to $node -command $cmd
     set substatus($xlib,$to) sent-unsubscribe
 }
 
@@ -331,7 +331,7 @@
 	}
     }
 
-    set cmd [list pep::publish_item $xlib $node tune \
+    set cmd [list ::xmpp::pep::publishItem $xlib $node tune \
 		  -payload [list [::xmpp::xml::create tune \
 					    -xmlns $node \
 					    -subelements $content]]]
@@ -353,7 +353,7 @@
 	}
     }
 
-    set cmd [list pep::delete_item $xlib $node tune \
+    set cmd [list ::xmpp::pep::deleteItem $xlib $node tune \
 		  -notify true]
 
     if {$callback != ""} {

Modified: trunk/tkabber/pubsub.tcl
===================================================================
--- trunk/tkabber/pubsub.tcl	2009-04-02 20:31:33 UTC (rev 1775)
+++ trunk/tkabber/pubsub.tcl	2009-04-05 15:58:14 UTC (rev 1776)
@@ -4,48 +4,14 @@
 # Personal Eventing via Pubsub Support (XEP-0163)
 #
 
+package require xmpp::pubsub
+
 ##########################################################################
 #
 # Publish-subscribe XEP-0060
 #
 
 namespace eval pubsub {
-    variable ns
-    array set ns [list \
-	collections                "http://jabber.org/protocol/pubsub#collections" \
-	config-node                "http://jabber.org/protocol/pubsub#config-node" \
-	create-and-configure       "http://jabber.org/protocol/pubsub#create-and-configure" \
-	create-nodes               "http://jabber.org/protocol/pubsub#create-nodes" \
-	delete-any                 "http://jabber.org/protocol/pubsub#delete-any" \
-	delete-nodes               "http://jabber.org/protocol/pubsub#delete-nodes" \
-	get-pending                "http://jabber.org/protocol/pubsub#get-pending" \
-	instant-nodes              "http://jabber.org/protocol/pubsub#instant-nodes" \
-	item-ids                   "http://jabber.org/protocol/pubsub#item-ids" \
-	leased-subscription        "http://jabber.org/protocol/pubsub#leased-subscription" \
-	meta-data                  "http://jabber.org/protocol/pubsub#meta-data" \
-	manage-subscription        "http://jabber.org/protocol/pubsub#manage-subscription" \
-	modify-affiliations        "http://jabber.org/protocol/pubsub#modify-affiliations" \
-	multi-collection           "http://jabber.org/protocol/pubsub#multi-collection" \
-	multi-subscribe            "http://jabber.org/protocol/pubsub#multi-subscribe" \
-	outcast-affiliation        "http://jabber.org/protocol/pubsub#outcast-affiliation" \
-	persistent-items           "http://jabber.org/protocol/pubsub#persistent-items" \
-	presence-notifications     "http://jabber.org/protocol/pubsub#presence-notifications" \
-	publish                    "http://jabber.org/protocol/pubsub#publish" \
-	publisher-affiliation      "http://jabber.org/protocol/pubsub#publisher-affiliation" \
-	purge-nodes                "http://jabber.org/protocol/pubsub#purge-nodes" \
-	retract-items              "http://jabber.org/protocol/pubsub#retract-items" \
-	retrieve-affiliations      "http://jabber.org/protocol/pubsub#retrieve-affiliations" \
-	retrieve-default           "http://jabber.org/protocol/pubsub#retrieve-default" \
-	retrieve-items             "http://jabber.org/protocol/pubsub#retrieve-items" \
-	retrieve-subscriptions     "http://jabber.org/protocol/pubsub#retrieve-subscriptions" \
-	subscribe                  "http://jabber.org/protocol/pubsub#subscribe" \
-	subscription-options       "http://jabber.org/protocol/pubsub#subscription-options" \
-	subscription-notifications "http://jabber.org/protocol/pubsub#subscription-notifications" \
-	subscribe_authorization    "http://jabber.org/protocol/pubsub#subscribe_authorization" \
-	subscribe_options          "http://jabber.org/protocol/pubsub#subscribe_options" \
-	node_config                "http://jabber.org/protocol/pubsub#node_config" \
-	event                      "http://jabber.org/protocol/pubsub#event"]
-
     variable m2a
     variable a2m
     set aff_list [list [::msgcat::mc "Owner"] owner \
@@ -71,866 +37,118 @@
 
 ##########################################################################
 #
-# Entity use cases (5)
-#
-
-##########################################################################
-#
-# Discover features (5.1) is implemented in disco.tcl
-# Discover nodes (5.2) is implemented in disco.tcl
-# Discover node information (5.3) is implemented in disco.tcl
-# Discover node meta-data (5.4) is implemented in disco.tcl
-#
-
-##########################################################################
-#
-# Discover items for a node (5.5) is NOT implemented in disco.tcl
-# TODO
-#
-
-##########################################################################
-#
-# Retrieve subscriptions (5.6)
-#
-# Evaluates command for attribute lists
-#
-
-proc pubsub::retrieve_subscriptions {xlib service args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::retrieve_subscriptions: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create subscriptions]] \
-	-to $service \
-	-command [list [namespace current]::retrieve_subscriptions_result $command]
-}
-
-proc pubsub::retrieve_subscriptions_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
-	}
-	return
-    }
-
-    set items {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
-
-	if {$stag != "subscriptions"} continue
-
-	foreach item $ssubels {
-	    ::xmpp::xml::split \
-		$item sstag ssxmlns ssattrs sscdata sssubels
-
-	    if {$sstag == "subscription"} {
-		lappend items $ssattrs
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $items]
-    }
-}
-
-##########################################################################
-#
-# Retrieve affiliations (5.6)
-#
-# Evaluates command for attribute lists
-#
-
-proc pubsub::retrieve_affiliations {xlib service args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::retrieve_affiliations: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create affiliations]] \
-	-to $service \
-	-command [list [namespace current]::retrieve_affiliations_result $command]
-}
-
-proc pubsub::retrieve_affiliations_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
-	}
-	return
-    }
-
-    set items {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
-
-	if {$stag != "affiliations"} continue
-
-	foreach item $ssubels {
-	    ::xmpp::xml::split \
-		$item sstag ssxmlns ssattrs sscdata sssubels
-
-	    if {$sstag == "affiliation"} {
-		lappend items $ssattrs
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $items]
-    }
-}
-
-##########################################################################
-#
-# Subscriber use cases (6)
-#
-
-##########################################################################
-#
-# Subscribe to pubsub node "node" at service "service" (6.1)
-#
-# if node is empty then it's a subscription to root collection node (9.2)
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-#
-# Optional pubsub#subscribe_options parameters
-# -deliver
-# -digest
-# -expire
-# -include_body
-# -show-values
-# -subscription_type
-# -subscription_depth
-#
-
-proc pubsub::subscribe {xlib service node args} {
-    variable ns
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    set options [form_type $ns(subscribe_options)]
-    foreach {key val} $args {
-	switch -- $key {
-	    -jid { set jid $val }
-	    -resource { set resource $val }
-	    -command { set command $val }
-	    -deliver -
-	    -digest -
-	    -expire -
-	    -include_body -
-	    -show-values -
-	    -subscription_type -
-	    -subscription_depth {
-		set par [string range $opt 1 end]
-		set options [concat $options [field pubsub#$par $val]]
-	    }
-	}
-    }
-
-    if {![info exists jid]} {
-	set jid [connection_bare_jid $xlib]
-    }
-
-    if {[info exists resource]} {
-	append jid "/$resource"
-    }
-
-    set vars [list jid $jid]
-    if {$node != ""} {
-	lappend vars node $node
-    }
-
-    if {[llength $options] > 2} {
-	set options \
-	    [list [::xmpp::xml::create options \
-			    -subelement [::xmpp::data::submitForm $options]]]
-    } else {
-	set options {}
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create subscribe \
-					 -attrs $vars] \
-		    -subelements $options] \
-	-to $service \
-	-command [list [namespace current]::subscribe_result $command]
-}
-
-proc pubsub::subscribe_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res == "ok"} {
-	::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-	if {$xmlns == $::NS(pubsub)} {
-	    foreach subel $subels {
-		::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-
-		if {$stag == "subscription"} {
-		    set node [::xmpp::xml::getAttr $sattrs node]
-		    set jid [::xmpp::xml::getAttr $sattrs jid]
-		    set subid [::xmpp::xml::getAttr $sattrs subid]
-		    set subscription \
-			[::xmpp::xml::getAttr $sattrs subscription]
-		    # TODO: subscription-options
-		    if {$command != ""} {
-			eval $command [list $res \
-					    [list $node $jid \
-						  $subid $subscription]]
-			return
-		    }
-		}
-	    }
-	    if {$command != ""} {
-		# Something strange: OK without subscription details
-		eval $command [list $res {}]
-		return
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
-# Unsubscribe from pubsub node "node" at service "service" (6.2)
-#
-# if node is empty then it's a unsubscription from root collection node (9.2)
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-#
-
-proc pubsub::unsubscribe {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -jid { set jid $val }
-	    -subid { set subid $val }
-	    -resource { set resource $val }
-	    -command { set command $val }
-	}
-    }
-
-    if {![info exists jid]} {
-	set jid [connection_bare_jid $xlib]
-    }
-
-    if {[info exists resource]} {
-	append jid "/$resource"
-    }
-
-    set vars [list jid $jid]
-    if {$node != ""} {
-	lappend vars node $node
-    }
-    if {[info exists subid]} {
-	lappend vars subid $subid
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create unsubscribe \
-					-attrs $vars]] \
-	-to $service \
-	-command [list [namespace current]::unsubscribe_result $command]
-}
-
-proc pubsub::unsubscribe_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
 # Configure subscription options (6.3)
 #
 
-proc pubsub::request_subscription_options {xlib service node args} {
+proc pubsub::requestSubscriptionOptions {xlib service node args} {
 
     debugmsg pubsub [info level 0]
 
-    set command ""
+    set commands {}
+    set newArgs {}
     foreach {key val} $args {
 	switch -- $key {
-	    -jid { set jid $val }
-	    -subid { set subid $val }
-	    -resource { set resource $val }
-	    -command { set command $val }
+	    -command { set command [list $val] }
+	    default  { lappend newArgs $key $val }
 	}
     }
 
-    if {$node == ""} {
-	return -code error \
-	    "pubsub::request_subscription_options: Node is empty"
-    }
-
-    if {![info exists jid]} {
-	set jid [connection_bare_jid $xlib]
-    }
-
-    if {[info exists resource]} {
-	append jid "/$resource"
-    }
-
-    if {[info exists subid]} {
-	set vars [list node $node subid $subid jid $jid]
-    } else {
-	set vars [list node $node jid $jid]
-    }
-
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create options \
-					-attrs $vars]] \
-	-to $service \
-	-command [list [namespace current]::subscription_options_result \
-		       $xlib $service $command]
+    eval {::xmpp::pubsub::requestSubscriptionOptions $xlib $service $node} \
+	 $newArgs \
+	 {-command [namespace code [list SubscriptionOptionsResult \
+					 $xlib $service $commands]]}
 }
 
-proc pubsub::subscription_options_result {xlib service command res child} {
+proc pubsub::SubscriptionOptionsResult {xlib service commands status res} {
 
     debugmsg pubsub [info level 0]
 
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
+    if {![string equal $status ok]} {
+	if {[llength $commands] > 0} {
+	    eval [lindex $commands 0] [list $status $res]
 	}
 	return
     }
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
+    lassign $res attrs form
+    set node  [::xmpp::xml::getAttr $attrs node]
+    set jid   [::xmpp::xml::getAttr $attrs jid]
+    set subid [::xmpp::xml::getAttr $attrs subid]
 
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
-
-	if {$stag == "options"} {
-	    ::xmpp::xml::split \
-		[lindex $ssubels 0] sstag ssxmlns ssattrs sscdata sssubels
-	    set node [::xmpp::xml::getAttr $ssattrs node]
-	    set jid [::xmpp::xml::getAttr $ssattrs jid]
-	    set subid [::xmpp::xml::getAttr $ssattrs subid]
-	    break
-	}
-    }
-
-    data::draw_window $sssubels \
-	[list [namespace current]::send_subscribe_options
-	      $xlib $service $node $jid $subid $command]
+    data::draw_window $form \
+	[namespace code [list SendSubscriptionOptions
+	      $xlib $service $node $jid $subid $commands]]
 }
 
-proc pubsub::send_subscribe_options {xlib service node jid subid command w restags} {
+# TODO: $commands
+proc pubsub::SendSubscriptionOptions {xlib service node jid subid commands w restags} {
 
     debugmsg pubsub [info level 0]
 
     destroy $w.error.msg
     $w.bbox itemconfigure 0 -state disabled
 
-    if {$subid != ""} {
-	set vars [list node $node subid $subid jid $jid]
-    } else {
-	set vars [list node $node jid $jid]
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-			   -xmlns $::NS(pubsub) \
-			   -subelement [::xmpp::xml::create options \
-					    -attrs $vars \
-					    -subelements $restags]] \
-	-to $service \
-	-command [list data::test_error_res $w]
+    ::xmpp::pubsub::sendSubscriptionOptions $xlib $service $node $restags \
+	    -jid $jid -subid $subid -resource $resource \
+	    -command [list data::test_error_res $w]
 }
 
 ##########################################################################
 #
-# Retrieve items for a node (6.4)
-# Node must not be empty
-# Evaluates command with list of items
-#
-# -max_items $number (request $number last items)
-# -items $item_id_list (request specific items)
-
-proc pubsub::retrieve_items {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    set items {}
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	    -subid { set subid $val }
-	    -max_items { set max_items $val }
-	    -items {
-		foreach id $val {
-		    lappend items [::xmpp::xml::create item
-				       -attrs [list id $id]]
-		}
-	    }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::retrieve_items: Node is empty"
-    }
-
-    if {[info exists subid]} {
-	set vars [list node $node subid $subid]
-    } else {
-	set vars [list node $node]
-    }
-
-    if {[info exists max_items]} {
-	lappend vars max_items $max_items
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create items \
-				    -attrs $vars \
-				    -subelements $items]] \
-	-to $service \
-	-command [list [namespace current]::get_items_result $command]
-}
-
-proc pubsub::get_items_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
-	}
-	return
-    }
-
-    set items {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach ch $subels {
-	::xmpp::xml::split $ch stag sxmlns attrs scdata ssubels
-
-	if {$stag != "items"} continue
-
-	foreach item $ssubels {
-	    ::xmpp::xml::split $item sstag ssxmlns ssattrs sscdata sssubels
-
-	    if {$sstag == "item"} {
-		lappend items $item
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $items]
-    }
-}
-
-##########################################################################
-#
-# Publisher use cases (7)
-#
-
-##########################################################################
-#
-# Publish item "itemid" to pubsub node "node" at service "service" (7.1)
-# payload is a LIST of xml tags
-# node must not be empty
-
-proc pubsub::publish_item {xlib service node itemid args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    set payload {}
-    set transient 0
-    foreach {key val} $args {
-	switch -- $key {
-	    -transient { set transient $val }
-	    -payload { set payload $val }
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::publish_item: Node is empty"
-    }
-
-    if {$itemid == ""} {
-	set vars {}
-    } else {
-	set vars [list id $itemid]
-    }
-
-    if {$transient} {
-	set item {}
-    } else {
-	set item [list [::xmpp::xml::create item \
-			    -attrs $vars \
-			    -subelements $payload]]
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create publish \
-					-attrs [list node $node] \
-					-subelements $item]] \
-	-to $service \
-	-command [list [namespace current]::publish_item_result $command]
-}
-
-proc pubsub::publish_item_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
-# Delete item "itemid" from pubsub node "node" at service "service" (7.2)
-# node and itemid must not be empty
-# -notify is a boolean (true, false, 1, 0)
-
-proc pubsub::delete_item {xlib service node itemid args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    set notify 0
-    foreach {key val} $args {
-	switch -- $key {
-	    -notify { set notify $val }
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::delete_item: Node is empty"
-    }
-
-    if {$itemid == ""} {
-	return -code error "pubsub::delete_item: Item ID is empty"
-    }
-
-    set vars [list node $node]
-    if {[string is true -strict $notify]} {
-	lappend vars notify true
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create retract \
-				    -attrs $vars \
-				    -subelement [::xmpp::xml::create item \
-						  -attrs [list id $itemid]]]] \
-	-to $service \
-	-command [list [namespace current]::delete_item_result $command]
-}
-
-proc pubsub::delete_item_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
 # Owner use cases (8)
 #
 
 ##########################################################################
 #
-# Create pubsub node "node" at service "service" (8.1)
-#
-# 8.1.2 create_node xlib service node -command callback
-# or    create_node xlib service node -access_model model -command callback
-#
-# 8.1.3 create_node xlib service node -command callback \
-#				 -title title \
-#				  ........... \
-#				 -body_xslt xslt
-#
-# Optional pubsub#node_config parameters
-# -access_model
-# -body_xslt
-# -collection
-# -dataform_xslt
-# -deliver_notifications
-# -deliver_payloads
-# -itemreply
-# -children_association_policy
-# -children_association_whitelist
-# -children
-# -children_max
-# -max_items
-# -max_payload_size
-# -node_type
-# -notify_config
-# -notify_delete
-# -notify_retract
-# -persist_items
-# -presence_based_delivery
-# -publish_model
-# -replyroom
-# -replyto
-# -roster_groups_allowed
-# -send_last_published_item
-# -subscribe
-# -title
-# -type
-
-proc pubsub::create_node {xlib service node args} {
-    variable ns
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    set options {}
-    set fields [form_type $ns(node_config)]
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	    -access_model -
-	    -body_xslt -
-	    -collection -
-	    -dataform_xslt -
-	    -deliver_notifications -
-	    -deliver_payloads -
-	    -itemreply -
-	    -children_association_policy -
-	    -children_association_whitelist -
-	    -children -
-	    -children_max -
-	    -max_items -
-	    -max_payload_size -
-	    -node_type -
-	    -notify_config -
-	    -notify_delete -
-	    -notify_retract -
-	    -persist_items -
-	    -presence_based_delivery -
-	    -publish_model -
-	    -replyroom -
-	    -replyto -
-	    -roster_groups_allowed -
-	    -send_last_published_item -
-	    -subscribe -
-	    -title -
-	    -type {
-		set par [string range $opt 1 end]
-		set fields [concat $fields [field pubsub#$par $val]]
-	    }
-	}
-    }
-
-    if {$node == ""} {
-	set vars {}
-    } else {
-	set vars [list node $node]
-    }
-
-    if {[llength $fields] > 2} {
-	set fields [list [::xmpp::data::submitForm $fields]]
-    } else {
-	set fields {}
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub) \
-		    -subelement [::xmpp::xml::create create \
-					-attrs $vars] \
-		    -subelement [::xmpp::xml::create configure \
-					-subelements $fields]] \
-	-to $service \
-	-command [list [namespace current]::create_node_result \
-		       $node $command]
-}
-
-proc pubsub::form_type {value} {
-    return [list FORM_TYPE [list $value]]
-}
-
-proc pubsub::field {var value} {
-    return [list $var [list $value]]
-}
-
-proc pubsub::create_node_result {node command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res == "ok" && $node == ""} {
-	# Instant node: get node name from the answer
-
-	::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-	if {$xmlns == $::NS(pubsub)} {
-	    foreach subel $subels {
-		::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-		if {$stag == "create"} {
-		    set node [::xmpp::xml::getAttr $sattrs node]
-		}
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $node $res $child]
-    }
-}
-
-##########################################################################
-#
 # Configure pubsub node "node" at service "service" (8.2)
 # node must not be empty
 #
 
-proc pubsub::configure_node {xlib service node args} {
+proc pubsub::configureNode {xlib service node args} {
 
     debugmsg pubsub [info level 0]
 
-    set command ""
+    set commands {}
+    set newArgs {}
     foreach {key val} $args {
 	switch -- $key {
-	    -command { set command $val }
+	    -command { set commands [list $val] }
+	    default  { lappend newArgs $key $val }
 	}
     }
 
-    if {$node == ""} {
-	return -code error \
-	    "pubsub::configure_node: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create configure \
-					-attrs [list node $node]]] \
-	-to $service \
-	-command [list [namespace current]::configure_node_result \
-		       $xlib $service $command]
+    eval {::xmpp::pubsub::configureNode $xlib $service $node} $newArgs \
+	 {-command [namespace code [list ConfigureNodeResult \
+					 $xlib $service $commands]]}
 }
 
-proc pubsub::configure_node_result {xlib service command res child} {
+proc pubsub::ConfigureNodeResult {xlib service commands status res} {
 
     debugmsg pubsub [info level 0]
 
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
+    if {![string equal $status ok]} {
+	if {[llength $commands] > 0} {
+	    eval [lindex $commands 0] [list $status $res]
 	}
 	return
     }
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
+    lassign $res node form
 
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-
-	if {$stag == "configure"} {
-	    set node [::xmpp::xml::getAttr $sattrs node]
-	    ::xmpp::xml::split \
-		[lindex $ssubels 0] sstag ssxmlns ssattrs sscdata sssubels
-	    break
-	}
-    }
-
-    data::draw_window $sssubels \
-	[list [namespace current]::send_configure_node
-	      $xlib $service $node $command]
+    data::draw_window $form \
+	[namespace code [list SendConfigureNode
+	      $xlib $service $node $commands]]
 }
 
-proc pubsub::send_configure_node {xlib service node command w restags} {
+proc pubsub::SendConfigureNode {xlib service node commands w restags} {
 
     debugmsg pubsub [info level 0]
 
     destroy $w.error.msg
     $w.bbox itemconfigure 0 -state disabled
 
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-			   -xmlns $::NS(pubsub#owner) \
-			   -subelement [::xmpp::xml::create configure \
-					    -attrs [list node $node] \
-					    -subelements $restags]] \
-	-to $service \
-	-command [list data::test_error_res $w]
+    ::xmpp::pubsub::sendConfigureNode $xlib $service $node $restags \
+	    -command [list data::test_error_res $w]
 }
 
 ##########################################################################
@@ -938,171 +156,51 @@
 # Request default configuration options (8.3)
 #
 
-proc pubsub::request_default {xlib service args} {
+proc pubsub::requestDefaultConfig {xlib service args} {
     variable ns
 
     debugmsg pubsub [info level 0]
 
-    set command ""
-    set form [::xmpp::xml::create default]
+    set commands {}
+    set newArgs {}
     foreach {key val} $args {
 	switch -- $key {
-	    -command { set command $val }
-	    -node_type {
-		set form \
-		    [::xmpp::xml::create default \
-			 -subelement [::xmpp::data::submitForm \
-					     [concat [form_type $ns(node_config)] \
-						     [field pubsub#node_type $val]]]]
-	    }
+	    -command { set commands [list $val] }
+	    default  { lappend newArgs $key $val }
 	}
     }
 
-    if {$node == ""} {
-	return -code error \
-	    "pubsub::request_default: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement $form] \
-	-to $service \
-	-command [list [namespace current]::request_default_result \
-		       $xlib $service $command]
+    eval {::xmpp::pubsub::requestDefaultConfig $xlib $service} $newArgs \
+	 {-command [namespace code [list RequestDefaultConfigResult \
+					 $xlib $service $commands]]}
 }
 
-proc pubsub::request_default_result {xlib service command res child} {
+proc pubsub::RequestDefaultConfigResult {xlib service commands status form} {
 
     debugmsg pubsub [info level 0]
 
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
+    if {![string equal $status ok]} {
+	if {[llength $commands] > 0} {
+	    eval [lindex $commands 0] [list $status $form]
 	}
 	return
     }
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-
-	if {$stag == "default"} {
-	    ::xmpp::xml::split \
-		[lindex $ssubels 0] sstag ssxmlns ssattrs sscdata sssubels
-	    break
-	}
-    }
-
     # TODO: Don't send the form
-    data::draw_window $sssubels \
-	[list [namespace current]::send_request_results
-	      $xlib $service $node $command]
+    data::draw_window $form \
+	[namespace code [list SendRequestResults
+	      $xlib $service $commands]]
 }
 
-proc pubsub::send_request_results {xlib service node command w restags} {
+proc pubsub::SendRequestResults {xlib service commands w restags} {
 
     debugmsg pubsub [info level 0]
 
     destroy $w.error.msg
-    $w.bbox itemconfigure 0 -state disabled
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-			   -xmlns $::NS(pubsub#owner) \
-			   -subelement [::xmpp::xml::create default \
-					    -subelements $restags]] \
-	-to $service \
-	-command [list data::test_error_res $w]
 }
 
 ##########################################################################
 #
-# Delete a node (8.4)
-# node must not be empty
-#
-
-proc pubsub::delete_node {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::delete_node: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create delete \
-				    -attrs [list node $node]]] \
-	-to $service \
-	-command [list [namespace current]::delete_node_result $command]
-}
-
-proc pubsub::delete_node_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
-# Purge all node items (8.5)
-# node must not be empty
-#
-
-proc pubsub::purge_items {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::purge_items: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create purge \
-				    -attrs [list node $node]]] \
-	-to $service \
-	-command [list [namespace current]::purge_items_result $command]
-}
-
-proc pubsub::purge_items_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
-# Manage subscription requests (8.6)
-# is done in messages.tcl
-#
-
-##########################################################################
-#
 # Request all pending subscription requests (8.6.1)
 #
 
@@ -1117,221 +215,6 @@
 
 ##########################################################################
 #
-# Manage subscriptions (8.7)
-#
-# Callback is called with list of entities:
-# {jid JID subscription SUB subid ID}
-#
-
-proc pubsub::request_subscriptions {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::request_subscriptions: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create subscriptions \
-				    -attrs [list node $node]]] \
-	-to $service \
-	-command [list [namespace current]::subscriptions_result $command]
-}
-
-proc pubsub::subscriptions_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
-	}
-	return
-    }
-
-    set entities {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-
-	if {$stag != "subscriptions"} continue
-
-	foreach entity $ssubels {
-	    ::xmpp::xml::split \
-		$entity sstag ssxmlns ssattrs sscdata sssubels
-
-	    if {$sstag == "subscription"} {
-		lappend entities $ssattrs
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $entities]
-    }
-}
-
-##########################################################################
-
-proc pubsub::modify_subscriptions {xlib service node entities args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::modify_subscriptions: Node is empty"
-    }
-
-    set subscriptions {}
-    foreach entity $entities {
-	lappend subscriptions [::xmpp::xml::create subscription \
-					-attrs $entity]
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create subscriptions \
-					-attrs [list node $node] \
-					-subelements $subscriptions]] \
-	-to $service \
-	-command [list [namespace current]::modify_subscriptions_result $command]
-}
-
-proc pubsub::modify_subscriptions_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
-# Retrieve current affiliations (8.8)
-# Evaluates command with list of entity attributes lists
-#
-
-proc pubsub::request_affiliations {xlib service node args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::request_affiliations: Node is empty"
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create affiliations]] \
-	-to $service \
-	-command [list [namespace current]::affiliations_result $command]
-}
-
-proc pubsub::affiliations_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$res != "ok"} {
-	if {$command != ""} {
-	    eval $command [list $res $child]
-	}
-	return
-    }
-
-    set entities {}
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    foreach subel $subels {
-	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
-
-	if {$stag != "affiliations"} continue
-
-	foreach entity $ssubels {
-	    ::xmpp::xml::split \
-		$entity sstag ssxmlns sattrs sscdata sssubels
-
-	    if {$sstag == "affiliation"} {
-		lappend entities $ssattrs
-	    }
-	}
-    }
-
-    if {$command != ""} {
-	eval $command [list $res $entities]
-    }
-}
-
-##########################################################################
-
-proc pubsub::modify_affiliations {xlib service node entities args} {
-
-    debugmsg pubsub [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -command { set command $val }
-	}
-    }
-
-    if {$node == ""} {
-	return -code error "pubsub::modify_subscriptions: Node is empty"
-    }
-
-    set affiliations {}
-    foreach entity $entities {
-	lappend affiliations [::xmpp::xml::create affiliation \
-					-attrs $entity]
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create pubsub \
-		    -xmlns $::NS(pubsub#owner) \
-		    -subelement [::xmpp::xml::create affiliations \
-					-attrs [list node $node] \
-					-subelements $affiliations]] \
-	-to $service \
-	-command [list [namespace current]::modify_affiliations_result $command]
-}
-
-proc pubsub::modify_affiliations_result {command res child} {
-
-    debugmsg pubsub [info level 0]
-
-    if {$command != ""} {
-	eval $command [list $res $child]
-    }
-}
-
-##########################################################################
-#
 # Modifying entity affiliations
 # node must not be empty
 # TODO
@@ -1649,52 +532,6 @@
 
 ##########################################################################
 #
-# Collection nodes (9)
-#
-
-##########################################################################
-#
-# Subscribe to a collection node (9.1)
-# Implemented in
-# pubsub::subscribe xlib service node id \
-#		    -subscription_type {nodes|items} \
-#		    -subscription_depth {1|all}
-#
-
-##########################################################################
-#
-# Root collection node (9.2)
-# Implemented in pubsub::subscribe and pubsub::unsubscribe with empty node
-#
-
-##########################################################################
-#
-# Create collection node (9.3)
-# Implemented in
-# pubsub::create_node xlib service node \
-#		      -node_type collection
-#
-
-##########################################################################
-#
-# Create a node associated with a collection (9.4)
-# Implemented in
-# pubsub::create_node xlib service node \
-#		      -collection collection
-#
-
-##########################################################################
-#
-# Associate an existing node with a collection (9.5)
-# Implemented in TODO
-
-##########################################################################
-#
-# Diassociate an node from a collection (9.6)
-# Implemented in TODO
-
-##########################################################################
-#
 # Framework for handling of Pubsub event notifications.
 
 proc pubsub::register_event_notification_handler {xmlns h} {
@@ -1708,7 +545,7 @@
 proc pubsub::process_event_notification {xlib from mid type is_subject subject body \
     err thread priority x} {
 
-    variable ::pubsub::ns
+    variable ns
     variable handler
 
     set res ""
@@ -1737,4 +574,54 @@
 
 hook::add process_message_hook pubsub::process_event_notification
 
+##########################################################################
+
+proc pubsub::disco_node_menu_setup {m bw tnode data parentdata} {
+    lassign $data type xlib jid node
+    switch -- $type {
+	item -
+	item2 {
+	    set identities [disco::browser::get_identities $bw $tnode]
+
+	    if {[lempty $identities]} {
+		set identities [disco::browser::get_parent_identities $bw $tnode]
+	    }
+
+	    foreach id $identities {
+		if {[::xmpp::xml::getAttr $id category] == "pubsub"} {
+
+		    $m add command -label [::msgcat::mc "Request default configuration"] \
+			-command [namespace code [list requestDefaultConfig $xlib $jid \
+					-command [namespace code test_result]]]
+		    if {$node == ""} {
+			set state disabled
+		    } else {
+			set state normal
+		    }
+
+		    $m add command -label [::msgcat::mc "Configure node"] \
+			-command [namespace code [list configureNode $xlib $jid $node \
+					-command [namespace code test_result]]] \
+			-state $state
+		    return
+		}
+	    }
+	}
+    }
+}
+
+hook::add disco_node_menu_hook pubsub::disco_node_menu_setup 60
+
+proc pubsub::test_result {status xml} {
+    if {[string equal $status ok]} {
+	return
+    }
+
+    NonmodalMessageDlg [epath] \
+	    -aspect 50000 \
+	    -icon error \
+	    -title [::msgcat::mc "Error"] \
+	    -message [::msgcat::mc "Pubsub error: %s" [error_to_string $xml]]
+}
+
 # vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list