[Tkabber-dev] r1598 - in trunk/tkabber: . ifacetk

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 2 16:59:58 MSK 2008


Author: sergei
Date: 2008-11-02 16:59:57 +0300 (Sun, 02 Nov 2008)
New Revision: 1598

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/login.tcl
   trunk/tkabber/register.tcl
Log:
	* register.tcl, login.tcl, ifacetk/iface.tcl: Moved changing password
	  to register.tcl and make using xmpp::register package for it.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-11-02 09:50:10 UTC (rev 1597)
+++ trunk/tkabber/ChangeLog	2008-11-02 13:59:57 UTC (rev 1598)
@@ -15,6 +15,9 @@
 
 	* search.tcl: Cleanup form data upon search window is destroyed.
 
+	* register.tcl, login.tcl, ifacetk/iface.tcl: Moved changing password
+	  to register.tcl and make using xmpp::register package for it.
+
 2008-11-01  Sergei Golovan  <sgolovan at nes.ru>
 
 	* Makefile: Added rules to make documentation (tkabber.html and

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2008-11-02 09:50:10 UTC (rev 1597)
+++ trunk/tkabber/ifacetk/iface.tcl	2008-11-02 13:59:57 UTC (rev 1598)
@@ -322,7 +322,7 @@
 		       -command {show_logout_dialog}] \
 		  {separator} \
 		  [list command [::msgcat::mc "Change password..."] {} {} {} \
-		       -command {change_password_dialog}] \
+		       -command {::register::password [lindex [connections] 0]}] \
 		  [list command [::msgcat::mc "Edit my info..."] {} {} {} \
 		       -command {
 			    if {[llength [connections]] > 0} {

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2008-11-02 09:50:10 UTC (rev 1597)
+++ trunk/tkabber/login.tcl	2008-11-02 13:59:57 UTC (rev 1598)
@@ -840,111 +840,6 @@
 }
 
 # TODO
-proc change_password_dialog {} {
-    global oldpassword newpassword password
-
-    set oldpassword ""
-    set newpassword ""
-    set password ""
-
-    if {[winfo exists .passwordchange]} {
-	destroy .passwordchange
-    }
-    
-    Dialog .passwordchange -title [::msgcat::mc "Change password"] \
-	-separator 1 -anchor e -default 0 -cancel 1
-
-    .passwordchange add -text [::msgcat::mc "OK"] -command {
-	destroy .passwordchange
-	send_change_password
-    }
-    .passwordchange add -text [::msgcat::mc "Cancel"] -command [list destroy .passwordchange]
-
-
-    set p [.passwordchange getframe]
-    
-    label $p.loldpass -text [::msgcat::mc "Old password:"]
-    ecursor_entry [entry $p.oldpass -show * -textvariable oldpassword]
-    label $p.lnewpass -text [::msgcat::mc "New password:"]
-    ecursor_entry [entry $p.newpass -show * -textvariable newpassword]
-    label $p.lpassword -text [::msgcat::mc "Repeat new password:"]
-    ecursor_entry [entry $p.password -show * -textvariable password]
-
-    grid $p.loldpass  -row 0 -column 0 -sticky e
-    grid $p.oldpass   -row 0 -column 1 -sticky ew
-    grid $p.lnewpass  -row 1 -column 0 -sticky e
-    grid $p.newpass   -row 1 -column 1 -sticky ew
-    grid $p.lpassword -row 2 -column 0 -sticky e
-    grid $p.password  -row 2 -column 1 -sticky ew
-
-    focus $p.oldpass
-    .passwordchange draw
-
-}
-
-# TODO
-proc send_change_password {xlib} {
-    global loginconf
-    global oldpassword newpassword password
-
-    if {$oldpassword != $loginconf(password)} {
-	MessageDlg .auth_err -aspect 50000 -icon error \
-	        -message [::msgcat::mc "Old password is incorrect"] \
-		-type user -buttons ok -default 0 -cancel 0
-	return
-    }
-    if {$newpassword != $password} {
-	MessageDlg .auth_err -aspect 50000 -icon error \
-	        -message [::msgcat::mc "New passwords do not match"] \
-		-type user -buttons ok -default 0 -cancel 0
-	return
-    }
-
-    ::xmpp::sendIQ $xlib set \
-	    -query [::xmpp::xml::create query \
-		    -xmlns jabber:iq:register \
-		    -subtelement [::xmpp::xml::create username \
-					-cdata $loginconf(user)] \
-		    -subelement  [::xmpp::xml::create password \
-					-cdata $password]] \
-	    -to $loginconf(server) \
-	    -command recv_change_password_result
-}
-
-# TODO
-proc recv_change_password_result {res args} {
-    global loginconf
-    global newpassword
-
-    if {$res == "ok"} {
-	MessageDlg .shpasswd_result -aspect 50000 -icon info \
-		-message [::msgcat::mc "Password is changed"] \
-		-type user -buttons ok -default 0 -cancel 0
-	for {set i 1} {[info exists ::loginconf$i]} {incr i} {
-	    if {!([info exists ::loginconf${i}(user)] && \
-		    [info exists ::loginconf${i}(server)] && \
-		    [info exists ::loginconf${i}(password)])} {
-		continue
-	    }
-	    upvar ::loginconf${i}(user) user
-	    upvar ::loginconf${i}(server) server
-	    upvar ::loginconf${i}(password) password
-	    if {[string equal $user $loginconf(user)] && \
-		    [string equal $server $loginconf(server)] && \
-		    [string equal $password $loginconf(password)]} {
-		set password $newpassword
-	    }
-	}
-	set loginconf(password) $newpassword
-    } else {
-	MessageDlg .shpasswd_result -aspect 50000 -icon error \
-	    -message [::msgcat::mc "Password change failed: %s" \
-				   [error_to_string [lindex $args 0]]] \
-	    -type user -buttons ok -default 0 -cancel 0
-    }
-}
-
-# TODO
 proc show_logout_dialog {} {
     global reason reasonlist
 

Modified: trunk/tkabber/register.tcl
===================================================================
--- trunk/tkabber/register.tcl	2008-11-02 09:50:10 UTC (rev 1597)
+++ trunk/tkabber/register.tcl	2008-11-02 13:59:57 UTC (rev 1598)
@@ -12,6 +12,7 @@
     }
 
     set w .register[incr winid]
+
     toplevel $w
     wm group $w .
     set title [::msgcat::mc "Register in %s" $jid]
@@ -86,7 +87,7 @@
 	    set focus [data::fill_fields_x $f $fields]
 
 	    $w.bbox itemconfigure 0 -state normal
-	    if {$jid != [connection_server $xlib]} {
+	    if {![::xmpp::jid::equal $jid [connection_server $xlib]]} {
 		$w.bbox itemconfigure 1 -state normal
 	    }
 
@@ -137,44 +138,146 @@
 	-command [namespace code [list RecvResult $w $xlib $jid]]
 }
 
+proc register::password {xlib} {
+    variable winid
 
+    if {![info exists winid]} {
+	set winid 0
+    }
+
+    set w .register[incr winid]
+
+    toplevel $w
+    wm group $w .
+    set title [::msgcat::mc "Change password for %s" [connection_bare_jid $xlib]]
+    wm title $w $title
+    wm iconname $w $title
+    wm transient $w .
+    if {$::tcl_platform(platform) == "macintosh"} {
+        catch { unsupported1 style $w floating sideTitlebar }
+    } elseif {$::aquaP} {
+        ::tk::unsupported::MacWindowStyle style $w dBoxProc
+    }
+    wm resizable $w 0 0
+
+    set hf [frame $w.error]
+    set vf [frame $w.vf]
+    set sep [Separator::create $w.sep -orient horizontal]
+
+    set sw [ScrolledWindow $w.sw]
+    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
+    set f [$sf getframe]
+    $sf configure -height 10
+    $sw setwidget $sf
+
+    bindscroll $f $sf
+
+    set bbox [ButtonBox $w.bbox -spacing 0 -padx 10 -default 0]
+    $bbox add -text [::msgcat::mc "Submit"] \
+	-command [namespace code [list Password $w $f $xlib]]
+    $bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+    bind $w <Return> "ButtonBox::invoke $bbox default"
+    bind $w <Escape> "ButtonBox::invoke $bbox 1"
+    pack $bbox -padx 2m -pady 2m -anchor e -side bottom
+
+    pack $sep -side bottom -fill x -pady 1m
+    pack $hf -side top
+    pack $vf -side left -pady 2m
+    pack $sw -side top -expand yes -fill both -padx 2m -pady 2m
+
+    bind $f <Destroy> [list data::cleanup $f]
+
+    set fields \
+	[list instructions [::msgcat::mc "Enter the new password for %s" \
+					 [connection_bare_jid $xlib]] \
+	      field [list username hidden "" "" false \
+			  {} [list [connection_user $xlib]] {}] \
+	      field [list password text-private \
+			  [::msgcat::mc "New password:"] "" false \
+			  {} {} {}]]
+
+    wm withdraw $w
+
+    RecvFields $w $f $xlib "" ok $fields
+}
+
+proc register::Password {w f xlib} {
+    variable data
+
+    destroy $w.error.msg
+    $w.bbox itemconfigure 0 -state disabled
+
+    set username [connection_user $xlib]
+    set password ""
+    foreach {var values} [data::get_fields $f] {
+	switch -- $var {
+	    username {
+		set username [lindex $values 0]
+	    }
+	    password {
+		set password [lindex $values 0]
+	    }
+	}
+    }
+
+    ::xmpp::register::password $xlib $username $password \
+	-command [namespace code [list RecvResult $w $xlib ""]]
+}
+
 proc register::RecvResult {w xlib jid status xml} {
     variable data
 
     debugmsg register "$status $xml"
-    
-    if {![string equal $status ok]} {
-	$w.bbox itemconfigure 0 -state normal
-	if {$jid != [connection_server $xlib]} {
-	    $w.bbox itemconfigure 1 -state normal
+
+    switch -- $status {
+	ok {
+	    set result [::msgcat::mc "Registration is successful!"]
+	    label $w.result -text $result
+	    pack $w.result -expand yes -fill both -after $w.sw -anchor nw \
+			   -padx 1c -pady 1c
+	    pack forget $w.sw
+
+	    destroy $w.bbox
+	    set bbox [ButtonBox $w.bbox -spacing 0 -padx 10 -default 0]
+	    $bbox add -text [::msgcat::mc "Close"] -command [list destroy $w]
+	    bind $w <Return> "ButtonBox::invoke $w.bbox1 default"
+	    bind $w <Escape> "ButtonBox::invoke $w.bbox1 0"
+	    pack $bbox -padx 2m -pady 2m -anchor e -side bottom -before $w.sep
 	}
+	continue {
+	    set f [$sf getframe]
+	    foreach ch [winfo children $f] {
+		destroy $f
+	    }
+	    data::cleanup $f
 
-	set m [message $w.error.msg \
-		       -aspect 50000 \
-		       -text [error_to_string $xml] \
-		       -pady 2m]
-	$m configure -foreground [option get $m errorForeground Message]
-	pack $m
+	    destroy $w.bbox
+	    set bbox [ButtonBox $w.bbox -spacing 0 -padx 10 -default 0]
+	    $bbox add -text [::msgcat::mc "Submit"] \
+		-command [namespace code [list Register $w $f $xlib $jid false]]
+	    $bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+	    bind $w <Return> "ButtonBox::invoke $bbox default"
+	    bind $w <Escape> "ButtonBox::invoke $bbox 1"
+	    pack $bbox -padx 2m -pady 2m -anchor e -side bottom -before $w.sep
 
-	return
+	    RecvFields $w $f $xlib $jid ok $xml
+	}
+	default {
+	    $w.bbox itemconfigure 0 -state normal
+	    if {$jid != [connection_server $xlib]} {
+		$w.bbox itemconfigure 1 -state normal
+	    }
+
+	    set m [message $w.error.msg \
+			   -aspect 50000 \
+			   -text [error_to_string $xml] \
+			   -pady 2m]
+	    $m configure -foreground [option get $m errorForeground Message]
+	    pack $m
+	}
     }
-
-    set result [::msgcat::mc "Registration is successful!"]
-    label $w.result -text $result
-    pack $w.result -expand yes -fill both -after $w.sw -anchor nw \
-	-padx 1c -pady 1c
-    pack forget $w.sw
-
-    pack forget $w.bbox
-    set bbox [ButtonBox $w.bbox1 -spacing 0 -padx 10 -default 0]
-    $bbox add -text [::msgcat::mc "Close"] -command [list destroy $w]
-    bind $w <Return> "ButtonBox::invoke $w.bbox1 default"
-    bind $w <Escape> "ButtonBox::invoke $w.bbox1 0"
-    pack $bbox -padx 2m -pady 2m -anchor e -side bottom -before $w.sep
 }
 
-
 hook::add postload_hook \
     [list disco::browser::register_feature_handler $::NS(register) register::open \
     -desc [list * [::msgcat::mc "Register"]]]
-



More information about the Tkabber-dev mailing list