[Tkabber-dev] r1947 - trunk/tkabber

[tkabber-svn at jabber.ru]

Author: sergei
Date: 2010-10-25 20:10:54 +0400 (Mon, 25 Oct 2010)
New Revision: 1947

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/login.tcl
   trunk/tkabber/register.tcl
Log:
	* register.tcl, login.tcl: Preliminarily implemented request for
	  registration form after unsuccessfull login instead of sending the
	  prefilled fixed one.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2010-10-25 15:30:02 UTC (rev 1946)
+++ trunk/tkabber/ChangeLog	2010-10-25 16:10:54 UTC (rev 1947)
@@ -3,6 +3,9 @@
 	* iq.tcl: Added client_iq_hook for all incoming IQ stanzas.
 	* plugins/general/bob.tcl: Find and cache BOB elements in incoming IQ
 	  stanzas.
+	* register.tcl, login.tcl: Preliminarily implemented request for
+	  registration form after unsuccessfull login instead of sending the
+	  prefilled fixed one.
 
 2010-10-14  Sergei Golovan  <sgolovan at nes.ru>
 

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2010-10-25 15:30:02 UTC (rev 1946)
+++ trunk/tkabber/login.tcl	2010-10-25 16:10:54 UTC (rev 1947)
@@ -770,10 +770,7 @@
 						    [error_to_string $xml]] \
 			     -type user -buttons {yes no} -default 0 -cancel 1]
 		if {!$res} {
-		    ::xmpp::register::submit $xlib $lc(server) \
-			    [list username [list $lc(user)] \
-				  password [list $lc(password)]] \
-			    -old 1 \
+		    ::register::open $xlib $lc(server) \
 			    -command [list recv_register_result $xlib $logindata]
 		    return
 		}
@@ -796,12 +793,6 @@
 	ok {
 	    login $logindata
 	}
-	default {
-	    MessageDlg [epath] -aspect 50000 -icon error \
-		-message [::msgcat::mc "Registration failed: %s" \
-				       [error_to_string $xml]] \
-		-type user -buttons ok -default 0 -cancel 0
-	}
     }
 }
 

Modified: trunk/tkabber/register.tcl
===================================================================
--- trunk/tkabber/register.tcl	2010-10-25 15:30:02 UTC (rev 1946)
+++ trunk/tkabber/register.tcl	2010-10-25 16:10:54 UTC (rev 1947)
@@ -11,6 +11,13 @@
 	set winid 0
     }
 
+    set commands {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -command { set commands [list $val] }
+	}
+    }
+
     set w .register[incr winid]
 
     toplevel $w
@@ -40,12 +47,12 @@
 
     set bbox [ButtonBox $w.bbox -spacing 0 -padx 10 -default 0]
     $bbox add -text [::msgcat::mc "Register"] \
-	-command [namespace code [list Register $w $f $xlib $jid false]] \
+	-command [namespace code [list Register $w $f $xlib $jid $commands false]] \
         -state disabled
     $bbox add -text [::msgcat::mc "Unregister"] \
-	-command [namespace code [list Unregister $w $xlib $jid]] \
+	-command [namespace code [list Unregister $w $xlib $jid $commands]] \
         -state disabled
-    $bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+    $bbox add -text [::msgcat::mc "Cancel"] -command [namespace code [list Cancel $w $commands]]
     bind $w <Return> "ButtonBox::invoke [double% $bbox] default"
     bind $w <Escape> "ButtonBox::invoke [double% $bbox] 2"
     pack $bbox -padx 2m -pady 2m -anchor e -side bottom
@@ -60,10 +67,17 @@
     wm withdraw $w
 
     ::xmpp::register::request $xlib $jid \
-	-command [namespace code [list RecvFields $w $f $xlib $jid]]
+	-command [namespace code [list RecvFields $w $f $xlib $jid $commands]]
 }
 
-proc register::RecvFields {w f xlib jid status fields args} {
+proc register::Cancel {w commands} {
+    destroy $w
+    if {[llength $commands] > 0} {
+	uplevel #0 [lindex $commands 0] [list abort {}]
+    }
+}
+
+proc register::RecvFields {w f xlib jid commands status fields args} {
     debugmsg register "$status $fields"
 
     switch -- $status {
@@ -73,13 +87,16 @@
 		-message [::msgcat::mc "Registration: %s" \
 				       [error_to_string $fields]] \
 		-type user -buttons ok -default 0 -cancel 0
+	    if {[llength $commands] > 0} {
+		uplevel #0 [lindex $commands 0] [list $status $fields]
+	    }
 	}
 	ok {
 	    foreach {key val} $args {
 		switch -- $key {
 		    -old {
 			$w.bbox itemconfigure 0 \
-				-command [namespace code [list Register $w $f $xlib $jid $val]]
+				-command [namespace code [list Register $w $f $xlib $jid $commands $val]]
 		    }
 		}
 	    }
@@ -112,7 +129,7 @@
     }
 }
 
-proc register::Register {w f xlib jid old} {
+proc register::Register {w f xlib jid commands old} {
     variable data
 
     destroy $w.error.msg
@@ -122,7 +139,7 @@
     set fields [data::get_fields $f]
 
     ::xmpp::register::submit $xlib $jid $fields \
-	-command [namespace code [list RecvResult $w $xlib $jid]] \
+	-command [namespace code [list RecvResult $w $xlib $jid $commands]] \
 	-old $old
 }
 
@@ -135,7 +152,7 @@
     $w.bbox itemconfigure 1 -state disabled
 
     ::xmpp::register::remove $xlib $jid \
-	-command [namespace code [list RecvResult $w $xlib $jid]]
+	-command [namespace code [list RecvResult $w $xlib $jid $commands]]
 }
 
 proc register::password {xlib} {
@@ -224,7 +241,7 @@
 	-command [namespace code [list RecvResult $w $xlib ""]]
 }
 
-proc register::RecvResult {w xlib jid status xml} {
+proc register::RecvResult {w xlib jid commands status xml} {
     variable data
 
     debugmsg register "$status $xml"
@@ -243,6 +260,9 @@
 	    bind $w <Return> "ButtonBox::invoke [double% $bbox] default"
 	    bind $w <Escape> "ButtonBox::invoke [double% $bbox] 0"
 	    pack $bbox -padx 2m -pady 2m -anchor e -side bottom -before $w.sep
+	    if {[llength $commands] > 0} {
+		uplevel #0 [lindex $commands 0] [list $status $xml]
+	    }
 	}
 	continue {
 	    set f [$sf getframe]