[Tkabber-dev] r1237 - in trunk/tkabber: . ifacetk plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Sep 21 21:27:08 MSD 2007


Author: sergei
Date: 2007-09-21 21:27:08 +0400 (Fri, 21 Sep 2007)
New Revision: 1237

Added:
   trunk/tkabber/private.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/systray.tcl
   trunk/tkabber/plugins/roster/annotations.tcl
   trunk/tkabber/plugins/roster/conferences.tcl
   trunk/tkabber/plugins/roster/roster_delimiter.tcl
   trunk/tkabber/tkabber.tcl
Log:
	* private.tcl, tkabber.tcl: Separated interface to private XML storage
	  (XEP-0049). Eventually private information via pubsub (XEP-0223)
	  backend will be added.

	* plugins/roster/annotations.tcl, plugins/roster/conferences.tcl,
	  plugins/roster/roster_delimiter.tcl: Switched to a separated private
	  XML storage interface.

	* ifacetk/systray.tcl: Added call to [wm withdraw .] to please some
	  window managers when raising main window.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/ChangeLog	2007-09-21 17:27:08 UTC (rev 1237)
@@ -1,3 +1,16 @@
+2007-09-21  Sergei Golovan  <sgolovan at nes.ru>
+
+	* private.tcl, tkabber.tcl: Separated interface to private XML storage
+	  (XEP-0049). Eventually private information via pubsub (XEP-0223)
+	  backend will be added.
+
+	* plugins/roster/annotations.tcl, plugins/roster/conferences.tcl,
+	  plugins/roster/roster_delimiter.tcl: Switched to a separated private
+	  XML storage interface.
+
+	* ifacetk/systray.tcl: Added call to [wm withdraw .] to please some
+	  window managers when raising main window.
+
 2007-09-20  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/xaddress.tcl: Moved address rewriting to

Modified: trunk/tkabber/ifacetk/systray.tcl
===================================================================
--- trunk/tkabber/ifacetk/systray.tcl	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/ifacetk/systray.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -186,6 +186,9 @@
 	withdrawn {
 	    reshow
 	}
+	default {
+	    wm deiconify .
+	}
     }
     raise .
 }

Modified: trunk/tkabber/plugins/roster/annotations.tcl
===================================================================
--- trunk/tkabber/plugins/roster/annotations.tcl	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/plugins/roster/annotations.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -7,9 +7,7 @@
     # variable to store roster notes
     array set notes {}
 
-    variable NS
-    set NS(private) "jabber:iq:private"
-    set NS(rosternotes) "storage:rosternotes"
+    set ::NS(rosternotes) "storage:rosternotes"
 }
 
 proc annotations::free_notes {connid} {
@@ -24,11 +22,8 @@
     variable NS
     variable notes
 
-    jlib::send_iq get \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(rosternotes)]]]] \
+    private::retrieve [list [jlib::wrapper:createtag storage \
+				 -vars [list xmlns $::NS(rosternotes)]]] \
 	-command [list [namespace current]::process_notes $connid] \
 	-connection $connid
 }
@@ -36,19 +31,16 @@
 hook::add connected_hook [namespace current]::annotations::request_notes
 
 proc annotations::process_notes {connid res child} {
-    variable NS
     variable notes
 
     if {$res != "OK"} return
 
     array set notes {}
 
-    jlib::wrapper:splitxml $child tag vars isempty cdata children
-
-    foreach ch $children {
+    foreach ch $child {
 	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1
 
-	if {[jlib::wrapper:getattr $vars1 xmlns] == $NS(rosternotes)} {
+	if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(rosternotes)} {
 	    foreach note $children1 {
 		jlib::wrapper:splitxml $note ntag nvars nisempty ncdata nchildren
 
@@ -101,7 +93,6 @@
 }
 
 proc annotations::store_notes {connid} {
-    variable NS
     variable notes
 
     set notelist {}
@@ -128,12 +119,9 @@
 	}
     }
 
-    jlib::send_iq set \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(rosternotes)] \
-				 -subtags $notelist]]] \
+    private::store [list [jlib::wrapper:createtag storage \
+			      -vars [list xmlns $::NS(rosternotes)] \
+			      -subtags $notelist]] \
 	-command [list [namespace current]::store_notes_result $connid] \
 	-connection $connid
 }

Modified: trunk/tkabber/plugins/roster/conferences.tcl
===================================================================
--- trunk/tkabber/plugins/roster/conferences.tcl	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/plugins/roster/conferences.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -32,10 +32,8 @@
     # variable to store roster conference bookmarks
     array set bookmarks {}
 
-    variable NS
-    set NS(private) "jabber:iq:private"
-    set NS(bookmarks) "storage:bookmarks"
-    set NS(tkabber:groups) "tkabber:bookmarks:groups"
+    set ::NS(bookmarks) "storage:bookmarks"
+    set ::NS(tkabber:groups) "tkabber:bookmarks:groups"
 }
 
 ###############################################################################
@@ -57,25 +55,19 @@
 #
 
 proc conferences::request_bookmarks {connid} {
-    variable NS
     variable bookmarks
     variable responds
 
     set responds($connid) 0
     array unset bookmarks $connid,*
 
-    jlib::send_iq get \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(bookmarks)]]]] \
+    private::retrieve [list [jlib::wrapper:createtag storage \
+				 -vars [list xmlns $::NS(bookmarks)]]] \
 	-command [list [namespace current]::process_bookmarks $connid] \
 	-connection $connid
-    jlib::send_iq get \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(tkabber:groups)]]]] \
+
+    private::retrieve [list [jlib::wrapper:createtag storage \
+				 -vars [list xmlns $::NS(tkabber:groups)]]] \
 	-command [list [namespace current]::process_bookmarks $connid] \
 	-connection $connid
 }
@@ -83,7 +75,6 @@
 hook::add connected_hook [namespace current]::conferences::request_bookmarks 20
 
 proc conferences::process_bookmarks {connid res child} {
-    variable NS
     variable bookmarks
     variable responds
 
@@ -91,12 +82,10 @@
 
     incr responds($connid)
 
-    jlib::wrapper:splitxml $child tag vars isempty cdata children
-
-    foreach ch $children {
+    foreach ch $child {
 	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1
 
-	if {[jlib::wrapper:getattr $vars1 xmlns] == $NS(bookmarks)} {
+	if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(bookmarks)} {
 	    foreach bookmark $children1 {
 		jlib::wrapper:splitxml $bookmark btag bvars bisempty bcdata bchildren
 
@@ -128,7 +117,7 @@
 		    }
 		}
 	    }
-	} elseif {[jlib::wrapper:getattr $vars1 xmlns] == $NS(tkabber:groups)} {
+	} elseif {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(tkabber:groups)} {
 	    foreach bookmark $children1 {
 		jlib::wrapper:splitxml $bookmark btag bvars bisempty bcdata bchildren
 
@@ -167,7 +156,6 @@
 #
 
 proc conferences::store_bookmarks {connid} {
-    variable NS
     variable bookmarks
 
     set bookmarklist {}
@@ -201,20 +189,15 @@
 			       -subtags $groups]
     }
 
-    jlib::send_iq set \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(bookmarks)] \
-				 -subtags $bookmarklist]]] \
+    private::store [list [jlib::wrapper:createtag storage \
+			      -vars [list xmlns $::NS(bookmarks)] \
+			      -subtags $bookmarklist]] \
 	-command [list [namespace current]::store_bookmarks_result $connid] \
 	-connection $connid
-    jlib::send_iq set \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag storage \
-				 -vars [list xmlns $NS(tkabber:groups)] \
-				 -subtags $grouplist]]] \
+
+    private::store [list [jlib::wrapper:createtag storage \
+			      -vars [list xmlns $::NS(tkabber:groups)] \
+			      -subtags $grouplist]] \
 	-command [list [namespace current]::store_bookmarks_result $connid] \
 	-connection $connid
 }
@@ -226,6 +209,7 @@
     if {[winfo exists .store_bookmarks_error]} {
 	return
     }
+
     MessageDlg .store_bookmarks_error -aspect 50000 -icon error \
 	-message [format [::msgcat::mc "Storing conferences failed: %s"] \
 			 [error_to_string $child]] \

Modified: trunk/tkabber/plugins/roster/roster_delimiter.tcl
===================================================================
--- trunk/tkabber/plugins/roster/roster_delimiter.tcl	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/plugins/roster/roster_delimiter.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -21,12 +21,9 @@
 	    -command { set command $val }
 	}
     }
-    
-    jlib::send_iq get \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $::NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag roster \
-				 -vars [list xmlns $::NS(delimiter)]]]] \
+
+    private::retrieve [list [jlib::wrapper:createtag roster \
+				 -vars [list xmlns $::NS(delimiter)]]] \
 	-command [list [namespace current]::request_result \
 		       $connid $fallback $command] \
 	-connection $connid
@@ -38,9 +35,7 @@
     set delimiter $fallback
 
     if {$res == "OK"} {
-	jlib::wrapper:splitxml $child tag vars isempty cdata children
-
-	foreach ch $children {
+	foreach ch $child {
 	    jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1
 
 	    if {[jlib::wrapper:getattr $vars1 xmlns] == $NS(delimiter)} {
@@ -68,13 +63,10 @@
 	    -command { set command $val }
 	}
     }
-    
-    jlib::send_iq set \
-	[jlib::wrapper:createtag query \
-	     -vars [list xmlns $::NS(private)] \
-	     -subtags [list [jlib::wrapper:createtag roster \
-				 -vars [list xmlns $::NS(delimiter)] \
-				 -chdata $delimiter]]] \
+
+    private::store [list [jlib::wrapper:createtag roster \
+			      -vars [list xmlns $::NS(delimiter)] \
+			      -chdata $delimiter]] \
 	-command [list [namespace current]::store_result $connid $command] \
 	-connection $connid
     

Added: trunk/tkabber/private.tcl
===================================================================
--- trunk/tkabber/private.tcl	                        (rev 0)
+++ trunk/tkabber/private.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -0,0 +1,68 @@
+# $Id$
+#
+# Private XML Storage (XEP-0049) support
+#
+
+namespace eval private {}
+
+proc private::store {query args} {
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -command { set command $val }
+	    -connection { set connid $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "private::store: -connection is mandatory"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag query \
+	     -vars [list xmlns $::NS(private)] \
+	     -subtags $query] \
+	-command [list [namespace current]::store_result $command] \
+	-connection $connid
+}
+
+proc private::store_result {command res child} {
+    if {$command != ""} {
+	uplevel #0 $command [list $res $child]
+    }
+}
+
+proc private::retrieve {query args} {
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -command { set command $val }
+	    -connection { set connid $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "private::retrieve: -connection is mandatory"
+    }
+
+    jlib::send_iq get \
+	[jlib::wrapper:createtag query \
+	     -vars [list xmlns $::NS(private)] \
+	     -subtags $query] \
+	-command [list [namespace current]::retrieve_result $command] \
+	-connection $connid
+}
+
+proc private::retrieve_result {command res child} {
+    if {$command == ""} return
+
+    if {$res != "OK"} {
+	uplevel #0 $command [list $res $child]
+	return
+    }
+
+    jlib::wrapper:splitxml $child tag vars isempty cdata children
+
+    uplevel #0 $command [list OK $children]
+}
+


Property changes on: trunk/tkabber/private.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Modified: trunk/tkabber/tkabber.tcl
===================================================================
--- trunk/tkabber/tkabber.tcl	2007-09-20 18:48:16 UTC (rev 1236)
+++ trunk/tkabber/tkabber.tcl	2007-09-21 17:27:08 UTC (rev 1237)
@@ -250,6 +250,7 @@
 load_source gpgme.tcl
 load_source pubsub.tcl
 load_source pep.tcl
+load_source private.tcl
 load_source richtext.tcl
 
 load_source ifacetk bwidget_workarounds.tcl



More information about the Tkabber-dev mailing list