[Tkabber-dev] r1599 - in trunk/tkabber: . plugins/general plugins/iq

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 2 20:26:19 MSK 2008


Author: sergei
Date: 2008-11-02 20:26:19 +0300 (Sun, 02 Nov 2008)
New Revision: 1599

Removed:
   trunk/tkabber/negotiate.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/datagathering.tcl
   trunk/tkabber/disco.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/general/challenge.tcl
   trunk/tkabber/plugins/general/remote.tcl
   trunk/tkabber/plugins/general/xcommands.tcl
   trunk/tkabber/plugins/iq/version.tcl
   trunk/tkabber/si.tcl
   trunk/tkabber/tkabber.tcl
Log:
	* negotiate.tcl, tkabber.tcl, disco.tcl: Removed support for very old
	  form of feature negotiations.

	* datagathering.tcl: Moved creating data form field and submit form to
	  xmpp::data package.

	* muc.tcl, plugins/general/challenge.tcl,
	  plugins/general/xcommands.tcl, plugins/general/remote.tcl,
	  plugins/iq/version.tcl, si.tcl: Switched to xmpp::data package for
	  data forms processing.

	* messages.tcl: Made use of jabber:x:data explicit.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/ChangeLog	2008-11-02 17:26:19 UTC (rev 1599)
@@ -18,6 +18,19 @@
 	* register.tcl, login.tcl, ifacetk/iface.tcl: Moved changing password
 	  to register.tcl and make using xmpp::register package for it.
 
+	* negotiate.tcl, tkabber.tcl, disco.tcl: Removed support for very old
+	  form of feature negotiations.
+
+	* datagathering.tcl: Moved creating data form field and submit form to
+	  xmpp::data package.
+
+	* muc.tcl, plugins/general/challenge.tcl,
+	  plugins/general/xcommands.tcl, plugins/general/remote.tcl,
+	  plugins/iq/version.tcl, si.tcl: Switched to xmpp::data package for
+	  data forms processing.
+
+	* messages.tcl: Made use of jabber:x:data explicit.
+
 2008-11-01  Sergei Golovan  <sgolovan at nes.ru>
 
 	* Makefile: Added rules to make documentation (tkabber.html and

Modified: trunk/tkabber/datagathering.tcl
===================================================================
--- trunk/tkabber/datagathering.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/datagathering.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -12,11 +12,6 @@
 proc data::fill_fields {g items} {
     variable data
 
-    set row 0
-    set data(varlist,$g) {}
-    
-    grid columnconfig $g 1 -weight 1 -minsize 0
-
     lassign [::xmpp::data::findForm $items] type form
 
     if {[string equal $type form]} {
@@ -102,96 +97,6 @@
     return $res
 }
 
-###############################################################################
-# x:data processing
-###############################################################################
-
-# create field tag
-
-proc ::data::createfieldtag {type args}  {
-    array set params $args
-
-    switch -- $type {
-	instructions -
-	title {
-	    if {[info exists params(-value)]} {
-		return [::xmpp::xml::create $type -cdata $params(-value)]
-	    } else {
-		error "You must define -value"
-	    }
-	}
-
-	fixed - 
-	hidden -
-	list-single -
-	list-multi -
-	text-single - 
-	text-multi -
-	text-private -
-	jid-multi -
-	jid-single -
-	boolean {
-	    set vars [list type $type]
-
-	    if {[info exists params(-var)]} {
-		lappend vars var $params(-var)
-	    } elseif {![string equal $type fixed]} {
-		error "You must define -var"
-	    }
-
-	    if {[info exists params(-label)]} {
-		lappend vars label $params(-label)
-	    }
-
-	    set subtags  {}
-	    if {[info exists params(-descr)]} {
-		lappend subtags [::xmpp::xml::create descr \
-				     -cdata $params(-descr)]
-	    }
-	    if {[info exists params(-required)] && $params(-required)} {
-		lappend subtags [::xmpp::xml::create required]
-	    }
-	    if {[lcontain {jid-multi text-multi list-multi hidden fixed} $type]} {
-		if {[info exists params(-values)]} {
-		    foreach value $params(-values) {
-			lappend subtags [::xmpp::xml::create value \
-					     -cdata $value]
-		    }
-		} elseif {[lcontain {jid-multi hidden fixed} $type]} {
-		    error "You must define -values"
-		}
-	    } else {	    
-		if {[info exists params(-value)]} {
-		    lappend subtags [::xmpp::xml::create value \
-					 -cdata $params(-value)]
-		}
-	    }
-		
-	    if {[lcontain {list-multi list-single} $type]} {
-		if {[info exists params(-options)]} {
-		    foreach option $params(-options) {
-			lassign $option name label
-			lappend subtags \
-			    [::xmpp::xml::create option \
-				 -attrs [list label $label] \
-				 -subelement [::xmpp::xml::create value \
-							-cdata $name]]
-		    }
-		} else {
-		    error "You must define -options"
-		}
-	    }
-	    
-	    return [::xmpp::xml::create field -attrs $vars \
-					      -subelements $subtags]	    
-	}
-	
-	default {
-	    error "Unknown type $type"
-	}
-    }   
-}
-
 proc data::add_label {g row label {required 0}} {
     if {$label != ""} {
 	if {$required} {
@@ -253,9 +158,12 @@
     variable data
 
     set row 0
+    set data(varlist,$g) {}
     set data(allvarlist,$g) {}
     set focus ""
 
+    grid columnconfig $g 1 -weight 1 -minsize 0
+
     foreach {tag item} $items {
 	switch -- $tag {
 	    instructions {
@@ -464,37 +372,7 @@
 
 
 proc data::get_tags_x {g} {
-    variable data
-
-    set restags {}
-
-    foreach var $data(varlist,$g) {
-	if {[info exists data(multi,$var,$g)]} {
-	    set vartags {}
-	    foreach val $data(var,$var,$g) {
-	        lappend vartags [::xmpp::xml::create value -cdata $val]
-	    }
-	} elseif {[info exists data(text,$var,$g)]} {
-	    set data(var,$var,$g) [$data(text,$var,$g) get 1.0 "end -1c"]
-	    set vartags {}
-	    foreach val [split $data(var,$var,$g) \n] {
-	        lappend vartags [::xmpp::xml::create value -cdata $val]
-	    }
-	} else {
-	    set vartags [list [::xmpp::xml::create value \
-					    -cdata $data(var,$var,$g)]]
-	}
-	lappend restags [::xmpp::xml::create field \
-					     -attrs [list var $var] \
-					     -subelements $vartags]
-    }
-
-    set restag [list [::xmpp::xml::create x \
-					  -xmlns jabber:x:data \
-					  -attrs [list type submit] \
-					  -subelements $restags]]
-
-    return $restag
+    return [list [::xmpp::data::submitForm [get_fields $f]]]
 }
 
 ###############################################################################
@@ -612,10 +490,7 @@
 }
 
 proc data::cancel_data {xlib xmlns jid node w} {
-    send_data $xlib $xmlns $jid $node $w \
-	      [list [::xmpp::xml::create x \
-			    -xmlns jabber:x:data \
-			    -attrs [list type cancel]]]
+    send_data $xlib $xmlns $jid $node $w [list [::xmpp::data::cancelForm]]
 }
 
 proc data::send_data {xlib xmlns jid node w restags} {

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/disco.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -869,44 +869,6 @@
     browser_action $browser(sort,$w,$parent_tag) $w $parent_tag
 }
 
-proc disco::browser::negotiate_feature {tw xlib jid parent type} {
-    variable config
-
-    lassign [negotiate::send_request $xlib $jid $type] res opts
-
-    if {![winfo exists $tw]} return
-
-    if {$res != "ok"} {
-	set node [jid_to_tag "error negotiate $parent"]
-	set data [list error_negotiate $parent $xlib $jid]
-	set desc [::msgcat::mc "Error negotiate: %s" \
-		      [error_to_string $opts]]
-	set icon ""
-	
-	add_line $tw $parent $node $icon $desc $data \
-	    -fill $config(optioncolor)
-
-	remove_old $tw $parent option [list $node]
-	return
-    }
-
-    set optnodes {}
-
-    foreach opt $opts {
-	set node [jid_to_tag "option $opt $parent"]
-	lappend optnodes $node
-	set data [list option $opt $node]
-	set desc $opt
-	set icon ""
-	
-	add_line $tw $parent $node $icon $desc $data \
-	    -fill $config(optioncolor)
-    }
-    remove_old $tw $parent option $optnodes
-    remove_old $tw $parent error_negotiate {}
-}
-
-
 proc disco::browser::add_line {tw parent node icon desc data args} {
 
     if {[$tw exists $node]} {
@@ -1037,8 +999,6 @@
 			eval $browser(feature_handler,$var) [list $xlib $jid \
 			    -category $category -type $subtype]
 		    }
-		} else {
-		    negotiate_feature $tw $xlib $jid $tnode $var
 		}
 	    }
 	}

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/messages.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -222,16 +222,17 @@
     foreach xa $x {
 	::xmpp::xml::split $xa tag xmlns attrs cdata subels
 
-	switch -- $xmlns \
+	switch -- $xmlns {
 	    jabber:x:oob {
 		set row [process_x_oob $f $subels $row $from]
-	    } \
-	    $::NS(data) {
+	    }
+	    jabber:x:data {
 		if {[lindex $subels] > 0} {
 		    process_x_data $f $xlib $from $xa
 		}
-	    } \
+	    }
 	}
+    }
 
     return
 }

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/muc.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -943,9 +943,7 @@
     ::xmpp::sendIQ [chat::get_xlib $chatid] set \
 	-query [::xmpp::xml::create query \
 			-xmlns $::NS(muc#owner) \
-			-subelement [::xmpp::xml::create x \
-					-xmlns $::NS(data) \
-					-attrs [list type submit]]] \
+			-subelement [::xmpp::data::submitForm {}]] \
 	-to [chat::get_jid $chatid]
 }
 
@@ -996,9 +994,7 @@
     ::xmpp::sendIQ $xlib set \
 	-query [::xmpp::xml::create query \
 			   -xmlns $::NS(muc#owner) \
-			   -subelement [::xmpp::xml::create x \
-					       -xmlns jabber:x:data \
-					       -attrs [list type cancel]]] \
+			   -subelement [::xmpp::data::cancelForm]] \
 	-to $group \
 	-command [list muc::test_error_res \
 		       [::msgcat::mc "Cancelling configure form"] $xlib $group]

Deleted: trunk/tkabber/negotiate.tcl
===================================================================
--- trunk/tkabber/negotiate.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/negotiate.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -1,132 +0,0 @@
-# $Id$
-
-namespace eval negotiate {
-    set ::NS(negotiate) http://jabber.org/protocol/feature-neg
-    set seq 0
-}
-
-proc negotiate::get_handler {type xlib from child args} {
-    variable handler
-
-    debugmsg negotiate "$type: [list $from $child]"
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    set lang [::xmpp::xml::getAttr $args -lang en]
-
-    set error 1
-    set fields {}
-    foreach form $subels {
-	::xmpp::xml::split $form stag sxmlns sattrs scdata ssubels
-	if {$stag == "x" && \
-		$xmlns == $::NS(data) && \
-		[::xmpp::xml::getAttr $sattrs type] == "submit"} {
-
-		foreach field $ssubels {
-		    ::xmpp::xml::split $field \
-			    sstag ssxmlns ssattrs sscdata sssubels
-
-		    if {$sstag != "field"} continue
-
-		    set feature [::xmpp::xml::getAttr $ssattrs var]
-
-		    if {![info exists handler($feature)]} continue
-
-		    set error 0
-
-		    # TODO
-		    set opts [eval $handler($feature) \
-				   [list $type $xlib $from $lang $sssubels]]
-
-		    lappend fields $opts
-	    }
-	}
-    }
-    if {$error} {
-	return [list error cancel feature-not-implemented]
-    } else {
-	set res [::xmpp::xml::create feature \
-		     -xmlns $::NS(negotiate) \
-		     -subelement [::xmpp::xml::create x \
-					 -xmlns $::NS(data) \
-					 -attrs [list type result] \
-					 -subelements $fields]]
-	return [list result $res]
-    }
-}
-
-::xmpp::iq::register get feature $::NS(negotiate) \
-		     [list [namespace current]::negotiate::get_handler get]
-::xmpp::iq::register set feature $::NS(negotiate) \
-		     [list [namespace current]::negotiate::get_handler set]
-
-proc negotiate::register_handler {feature h} {
-    variable handler
-
-    set handler($feature) $h
-}
-
-proc negotiate::send_request {xlib to feature} {
-    variable seq
-    variable tmp
-
-    set i [incr seq]
-
-    set fieldtags {}
-    if {$feature != ""} {
-	lappend fieldtags [::xmpp::xml::create field \
-				-attrs [list var $feature]]
-    }
-
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create feature \
-			-xmlns $::NS(negotiate) \
-			-subelement [::xmpp::xml::create x \
-					    -xmlns $::NS(data) \
-					    -attrs [list type submit] \
-					    -subelements $fieldtags]] \
-	-to $to \
-	-command [list negotiate::recv_request_response $xlib $to $i]
-
-    vwait [namespace current]::tmp($i)
-    set res $tmp($i)
-    unset tmp($i)
-    return $res
-}
-
-proc negotiate::recv_request_response {xlib jid seq res child} {
-    variable tmp
-
-    if {$res != "ok"} {
-	set tmp($seq) [list $res $child]
-	return
-    }
-
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
-
-    if {$tag == "feature"} {
-	::xmpp::xml::split \
-	    [lindex $children 0] stag sxmlns sattrs scdata ssubels
-
-	data::draw_window $ssubels \
-	    [list [namespace current]::send_negotiation_form $xlib $jid]
-    }
-
-    set tmp($seq) [list ok {}]
-}
-
-proc negotiate::send_negotiation_form {xlib jid w restags} {
-    catch { destroy $w.error.msg }
-    $w.bbox itemconfigure 0 -state disabled
-
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create feature \
-			-xmlns $::NS(negotiate) \
-			-subelement [::xmpp::xml::create x \
-					-xmlns $::NS(data) \
-					-attrs [list type submit] \
-					-subelements $restags]] \
-	-to $jid \
-	-command [list data::test_error_res $w]
-}
-

Modified: trunk/tkabber/plugins/general/challenge.tcl
===================================================================
--- trunk/tkabber/plugins/general/challenge.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/plugins/general/challenge.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -18,16 +18,14 @@
 	if {$xmlns != $::NS(challenge)} continue
 
 	set challenge 1
-	foreach subel $subels {
-	    ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
 
-	    if {$sxmlns == $::NS(data) && [llength $ssubels] > 0} {
-		if {[catch {process_x_data $f $xlib $from $subel}]} {
-		    # Cannot process challenge form, so falling back to a
-		    # legacy challenge method if any.
-		    # TODO: Show error message to user.
-		    set challenge 0
-		}
+	lassign [::xmpp::data::findForm $subels] type form
+	if {$type == "form"} {
+	    if {[catch {process_x_data $f $xlib $from $form}]} {
+		# Cannot process challenge form, so falling back to a
+		# legacy challenge method if any.
+		# TODO: Show error message to user.
+		set challenge 0
 	    }
 	}
     }

Modified: trunk/tkabber/plugins/general/remote.tcl
===================================================================
--- trunk/tkabber/plugins/general/remote.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/plugins/general/remote.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -399,18 +399,17 @@
     upvar 0 $session state
     set lang $state(lang)
 
-    set fields {}
-
-    lappend fields [data::createfieldtag hidden \
+    set fields \
+	[concat [::xmpp::data::formField field \
 			-var FORM_TYPE \
-			-values "http://jabber.org/protocol/rc"]
-
-    lappend fields [data::createfieldtag title \
-			-value [::trans::trans $lang "Change Status"]]
-    lappend fields [data::createfieldtag instructions \
+			-type hidden \
+			-value "http://jabber.org/protocol/rc"] \
+		[::xmpp::data::formField title \
+			-value [::trans::trans $lang "Change Status"]] \
+		[::xmpp::data::formField instructions \
 			-value [::trans::trans $lang \
 				    "Choose status, priority, and\
-				     status message"]]
+				     status message"]]]
 
     set options {}
     foreach {status statusdesc} \
@@ -420,29 +419,30 @@
 		  xa          [::trans::trans $lang "Extended away"]  \
 		  dnd         [::trans::trans $lang "Do not disturb"] \
 		  unavailable [::trans::trans $lang "Unavailable"]] {
-	lappend options [list $status $statusdesc]
+	lappend options $statusdesc $status
     }
-    lappend fields [data::createfieldtag list-single \
+    set fields \
+	[concat $fields \
+		[::xmpp::data::formField field \
 			-var status \
+			-type list-single \
 			-label [::trans::trans $lang "Status"] \
 			-required 1 \
 			-value $userstatus \
-			-options $options]
-    lappend fields [data::createfieldtag text-single \
+			-options $options] \
+		[::xmpp::data::formField field \
 			-var status-priority \
+			-type text-single \
 			-label [::trans::trans $lang "Priority"] \
 			-value $userpriority \
-			-required 1]
-    lappend fields [data::createfieldtag text-multi \
+			-required 1] \
+		[::xmpp::data::formField field \
 			-var status-message \
+			-type text-multi \
 			-label [::trans::trans $lang "Message"] \
-			-values [split $textstatus "\n"]]
+			-values [split $textstatus "\n"]]]
 
-    return [list executing [::xmpp::xml::create x \
-				-xmlns $::NS(data) \
-				-attrs [list type form] \
-				-subelements $fields]]
-
+    return [list executing [::xmpp::data::form $fields]]
 }
 
 proc ::remote::change_status::set_step1 {session children} {
@@ -524,8 +524,8 @@
 	set jid [chat::get_jid $chatid]
 	if {![cequal [get_jid_presence_info show $xlib $jid] ""]} {
 	    set nick [get_our_groupchat_nick $chatid]
-	    lappend options [list $jid [format [::trans::trans $lang "%s at %s"] \
-					       $nick $jid]]
+	    lappend options [format [::trans::trans $lang "%s at %s"] \
+				    $nick $jid] $jid
 	}
     }
     if {[llength $options] == 0} {
@@ -535,34 +535,33 @@
 						 "No groupchats to leave"]]]
     }
 
-    set fields {}
-
-    lappend fields [data::createfieldtag hidden \
+    set fields \
+	[concat [::xmpp::data::formField field \
 			-var FORM_TYPE \
-			-values "http://jabber.org/protocol/rc"]
-    lappend fields [data::createfieldtag title \
-			-value [::trans::trans $lang "Leave Groupchats"]]
-    lappend fields [data::createfieldtag instructions \
+			-type hidden \
+			-value "http://jabber.org/protocol/rc"] \
+		[::xmpp::data::formField title \
+			-value [::trans::trans $lang "Leave Groupchats"]] \
+		[::xmpp::data::formField instructions \
 			-value [::trans::trans $lang \
-				    "Choose groupchats you want to leave"]]
-
-    lappend fields [data::createfieldtag boolean \
+				    "Choose groupchats you want to leave"]] \
+		[::xmpp::data::formField field \
 			-var x-all \
+			-type boolean \
 			-label [::trans::trans $lang "Leave all groupchats"] \
-			-value 0]
-    lappend fields [data::createfieldtag list-multi \
+			-value 0] \
+		[::xmpp::data::formField field \
 			-var groupchats \
+			-type list-multi \
 			-label [::trans::trans $lang "Groupchats"] \
 			-required 1 \
-			-options $options]
-    lappend fields [data::createfieldtag text-single \
+			-options $options] \
+		[::xmpp::data::formField field \
 			-var x-reason \
-			-label [::trans::trans $lang "Reason"]]
+			-type text-single \
+			-label [::trans::trans $lang "Reason"]]]
 
-    return [list executing [::xmpp::xml::create x \
-				-xmlns $::NS(data) \
-				-attrs [list type form] \
-				-subelements $fields]]
+    return [list executing [::xmpp::data::form $fields]]
 }
 
 proc ::remote::leave_groupchats::set_step1 {session children} {
@@ -673,7 +672,7 @@
 	    default   { set msg [::trans::trans $lang "%s: %s unknown message(s)"] }
 	}
 
-	lappend options [list $id [format $msg $name $count]]
+	lappend options [format $msg $name $count] $id
     }
     if {[llength $options] == 0} {
 	return [list completed [::xmpp::xml::create note \
@@ -683,33 +682,31 @@
 					     "There are no unread messages"]]]
     }
 
-    set fields {}
-
-    lappend fields [data::createfieldtag hidden \
+    set fields \
+	[concat [::xmpp::data::formField field \
     			-var FORM_TYPE \
-    			-values "tkabber:plugins:remote:forward_form"]
-    lappend fields [data::createfieldtag title \
+			-type hidden \
+    			-value "tkabber:plugins:remote:forward_form"] \
+		[::xmpp::data::formField title \
 			-value [::trans::trans $lang \
-				    "Forward Unread Messages"]]
-    lappend fields [data::createfieldtag instructions \
+				    "Forward Unread Messages"]] \
+		[::xmpp::data::formField instructions \
 			-value [::trans::trans $lang \
 				    "Choose chats or groupchats from which you\
-				     want to forward messages"]]
-
-    lappend fields [data::createfieldtag boolean \
+				     want to forward messages"]] \
+		[::xmpp::data::formField field \
 			-var all \
+			-type boolean \
 			-label [::trans::trans $lang "Forward all messages"] \
-			-value 0]
-    lappend fields [data::createfieldtag list-multi \
+			-value 0] \
+		[::xmpp::data::formField field \
 			-var chats \
+			-type list-multi \
 			-label [::trans::trans $lang "Forward messages from"] \
 			-required 1 \
-			-options $options]
+			-options $options]]
 
-    return [list executing [::xmpp::xml::create x \
-				-xmlns $::NS(data) \
-				-attrs [list type form] \
-				-subelements $fields]]
+    return [list executing [::xmpp::data::form $fields]]
 }
 
 proc ::remote::forward::set_step1 {session children} {

Modified: trunk/tkabber/plugins/general/xcommands.tcl
===================================================================
--- trunk/tkabber/plugins/general/xcommands.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/plugins/general/xcommands.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -70,8 +70,10 @@
 
     lassign [find_note $xmldata] type note
     lassign [find_actions $xmldata] actions execute
+
     # Only jabber:x:data payloads are supported
-    set xdata [find_xdata $xmldata]
+    lassign [::xmpp::data::findForm $xmldata] type form
+    set xdata [::xmpp::data::parseForm $form]
 
     switch -- $status {
 	executing -
@@ -102,7 +104,7 @@
     set nf [frame $w.note]
 
     pack_note $nf $type $note
-    set focus [data::fill_fields $f $xdata]
+    set focus [data::fill_fields_x $f $xdata]
 
     switch -- $status {
 	executing {
@@ -151,7 +153,7 @@
     # Can't configure -cancel option because of bug in BWidget
     # $w configure -cancel $cancel
     bind $w <Escape> "$w invoke $cancel"
-    bind $w <Destroy> [list data::cleanup $f]
+    bind $f <Destroy> [list data::cleanup $f]
 
     bindscroll $f $sf
 
@@ -188,7 +190,7 @@
 	-query [::xmpp::xml::create command \
 			-xmlns $::NS(commands) \
 			-attrs $vars \
-			-subelements [data::get_tags $f]] \
+			-subelement [::xmpp::data::submitForm [data::get_fields $f]]] \
 	-command [list $cmd $w $xlib $jid $node $sessionid] \
 	-to $jid
 }
@@ -341,8 +343,10 @@
 
     lassign [find_note $subels] type note
     lassign [find_actions $subels] actions execute
+
     # Only jabber:x:data payloads are supported
-    set xdata [find_xdata $subels]
+    lassign [::xmpp::data::findForm $subels] type form
+    set xdata [::xmpp::data::parseForm $form]
 
     set f [$w.fields getframe]
 
@@ -355,7 +359,7 @@
     set nf $w.note
 
     pack_note $nf $type $note
-    set focus [data::fill_fields $f $xdata]
+    set focus [data::fill_fields_x $f $xdata]
 
     destroy $w
     draw_window $xlib $jid $node $sessionid $status $subels
@@ -421,19 +425,6 @@
 
 ##########################################################################
 
-proc xcommands::find_xdata {xmldata} {
-    set xdata {}
-    foreach child $xmldata {
-	::xmpp::xml::split $child tag xmlns attrs cdata subels
-	if {$xmlns == $::NS(data)} {
-	    lappend xdata $child
-	}
-    }
-    return $xdata
-}
-
-##########################################################################
-
 proc xcommands::find_note {xmldata} {
     set note ""
     set type info

Modified: trunk/tkabber/plugins/iq/version.tcl
===================================================================
--- trunk/tkabber/plugins/iq/version.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/plugins/iq/version.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -172,20 +172,10 @@
     variable options
 
     set fields \
-	[list [::xmpp::xml::create field \
-		   -attrs [list var  FORM_TYPE \
-				type hidden] \
-		   -subelement [::xmpp::xml::create value \
-				    -cdata urn:xmpp:dataforms:softwareinfo]] \
-	      [::xmpp::xml::create field \
-		   -attrs [list var software] \
-		   -subelement [::xmpp::xml::create value \
-				    -cdata Tkabber]] \
-	      [::xmpp::xml::create field \
-		   -attrs [list var software_version] \
-		   -subelement [::xmpp::xml::create value \
-				    -cdata "$tkabber_version\
-					    ($toolkit_version)"]]]
+	[list field [list FORM_TYPE hidden "" {urn:xmpp:dataforms:softwareinfo}] \
+	      field [list software "" "" {Tkabber}] \
+	      field [list software_version "" "" \
+			  [list "$tkabber_version ($toolkit_version)"]]]
 
     if {$options(reply_iq_os_version)} {
 	switch -glob -- $tcl_platform(os) {
@@ -202,21 +192,11 @@
 	    }
 	}
     
-	lappend fields \
-		[::xmpp::xml::create field \
-		     -attrs [list var os] \
-		     -subelement [::xmpp::xml::create value \
-				        -cdata $os]] \
-		[::xmpp::xml::create field \
-		     -attrs [list var os_version] \
-		     -subelement [::xmpp::xml::create value \
-					-cdata $os_version]]
+	lappend fields field [list os "" "" [list $os]] \
+		       field [list os_version "" "" [list $os_version]]
     }
 
-    return [::xmpp::xml::create x \
-		    -xmlns $::NS(data) \
-		    -attrs [list type result] \
-		    -subelements $fields]
+    return [::xmpp::data::resultForm $fields]
 }
 
 hook::add postload_hook \

Modified: trunk/tkabber/si.tcl
===================================================================
--- trunk/tkabber/si.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/si.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -107,29 +107,20 @@
 	set name [lindex $t 0]
 	if {![info exists transport(allowed,$name)] || \
 		$transport(allowed,$name)} {
-	    lappend options $transport(oppos,$name)
+	    lappend options "" $transport(oppos,$name)
 	}
     }
 
-    set opttags {}
-    foreach opt $options {
-	lappend opttags [::xmpp::xml::create option \
-			     -subelement [::xmpp::xml::create value \
-						 -cdata $opt]]
-    }
+    set fields [::xmpp::data::formField field \
+			-var stream-method \
+			-type list-single \
+			-options $options]
 
     set feature \
 	[::xmpp::xml::create feature \
 	     -xmlns http://jabber.org/protocol/feature-neg \
-	     -subelement [::xmpp::xml::create x \
-				-xmlns jabber:x:data \
-				-attrs [list type form] \
-			-subelement [::xmpp::xml::create field \
-					-attrs [list var stream-method \
-						     type list-single] \
-					-subelements $opttags]]]
+	     -subelement [::xmpp::data::form $fields]]
 
-
     set_status [::msgcat::mc "Opening SI connection"]
 
     ::xmpp::sendIQ $state(xlib) set \
@@ -267,51 +258,45 @@
 proc si::parse_negotiation {xml} {
     ::xmpp::xml::split $xml tag xmlns attrs cdata subels
 
-    set options {}
-    foreach item $subels {
-	::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
-	if {[string equal $sxmlns jabber:x:data]} {
-	    foreach sitem $ssubels {
-		::xmpp::xml::split $sitem sstag ssxmlns ssattrs sscdata sssubels
-		set var [::xmpp::xml::getAttr $ssattrs var]
+    lassign [::xmpp::data::findForm $subels] type form
+    set fields [::xmpp::data::parseForm $form]
+
+    foreach {tag field} $fields {
+	switch -- $tag {
+	    field {
+		lassign $field var type label desc required options values media
 		if {[string equal $var stream-method]} {
-		    foreach ssitem $sssubels {
-			::xmpp::xml::split $ssitem \
-				s3tag s3xmlns s3attrs s3cdata s3subels
-			foreach s3item $s3subels {
-			    ::xmpp::xml::split $s3item \
-					s4tag s4xmlns s4attrs s4cdata s4subels
-			    lappend options $s4cdata
-			}
+		    set soptions {}
+		    foreach {olabel ovalue} $options {
+			lappend soptions $ovalue
 		    }
+		    return $soptions
 		}
 	    }
 	}
     }
-    return $options
+
+    return {}
 }
 
 proc si::parse_negotiation_res {xml} {
     ::xmpp::xml::split $xml tag xmlns attrs cdata subels
 
-    set options {}
-    foreach item $subels {
-	::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
-	if {[string equal $sxmlns jabber:x:data]} {
-	    foreach sitem $ssubels {
-		::xmpp::xml::split $sitem sstag ssxmlns ssattrs sscdata sssubels
-		set var [::xmpp::xml::getAttr $ssattrs var]
+    lassign [::xmpp::data::findForm $subels] type form
+    set fields [::xmpp::data::parseSubmit $form]
+
+    foreach {tag field} $fields {
+	switch -- $tag {
+	    field {
+		lassign $field var type label values
 		if {[string equal $var stream-method]} {
-		    foreach ssitem $sssubels {
-			::xmpp::xml::split $ssitem \
-				s3tag s3xmlns s3attrs s3cdata s3subels
-			lappend options $s3cdata
-		    }
+		    return $values
 		}
 	    }
 	}
     }
-    return $options
+
+    return {}
 }
 
 ###############################################################################
@@ -371,16 +356,13 @@
 	if {$profile_res != {}} {
 	    lappend res_elements $profile_res
 	}
-	set opttag [::xmpp::xml::create value -cdata $opt]
+
+	set fields [list stream-method [list $opt]]
 	lappend res_elements \
 	    [::xmpp::xml::create feature \
-		 -xmlns http://jabber.org/protocol/feature-neg \
-		 -subelement [::xmpp::xml::create x \
-				    -xmlns jabber:x:data \
-				    -attrs [list type submit] \
-				    -subelement [::xmpp::xml::create field \
-						    -attrs [list var stream-method] \
-						    -subelement $opttag]]]
+		    -xmlns http://jabber.org/protocol/feature-neg \
+		    -subelement [::xmpp::data::submitForm $fields]]
+
 	set res [::xmpp::xml::create si \
 			-xmlns $::NS(si) \
 			-subelements $res_elements]

Modified: trunk/tkabber/tkabber.tcl
===================================================================
--- trunk/tkabber/tkabber.tcl	2008-11-02 13:59:57 UTC (rev 1598)
+++ trunk/tkabber/tkabber.tcl	2008-11-02 17:26:19 UTC (rev 1599)
@@ -243,7 +243,6 @@
 load_source login.tcl
 load_source userinfo.tcl
 load_source datagathering.tcl
-load_source negotiate.tcl
 load_source mclistbox mclistbox.tcl
 load_source search.tcl
 load_source register.tcl



More information about the Tkabber-dev mailing list