[Tkabber-dev] r1595 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 2 11:08:40 MSK 2008


Author: sergei
Date: 2008-11-02 11:08:39 +0300 (Sun, 02 Nov 2008)
New Revision: 1595

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/datagathering.tcl
   trunk/tkabber/search.tcl
Log:
	* datagathering.tcl: Added a procedure which returns a list of entered
	  values for a given data form window. Also, removed a procedure which
	  returned variables list for a given form.

	* search.tcl: Switched to xmpp::search package for sending search
	  requests and parsing returned items.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-11-01 20:31:52 UTC (rev 1594)
+++ trunk/tkabber/ChangeLog	2008-11-02 08:08:39 UTC (rev 1595)
@@ -1,3 +1,12 @@
+2008-11-02  Sergei Golovan  <sgolovan at nes.ru>
+
+	* datagathering.tcl: Added a procedure which returns a list of entered
+	  values for a given data form window. Also, removed a procedure which
+	  returned variables list for a given form.
+
+	* search.tcl: Switched to xmpp::search package for sending search
+	  requests and parsing returned items.
+
 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-01 20:31:52 UTC (rev 1594)
+++ trunk/tkabber/datagathering.tcl	2008-11-02 08:08:39 UTC (rev 1595)
@@ -112,10 +112,25 @@
     return $restags
 }
 
-proc data::get_reported_fields {g} {
+proc data::get_fields {g} {
     variable data
 
-    return $data(varlist,$g)
+    set res {}
+
+    if {[info exists data(varlist,$g)]} {
+	foreach var $data(varlist,$g) {
+	    if {[info exists data(multi,$var,$g)]} {
+		lappend res $var $data(var,$var,$g)
+	    } elseif {[info exists data(text,$var,$g)]} {
+		set data(var,$var,$g) [$data(text,$var,$g) get 1.0 "end -1c"]
+		lappend res $var [split $data(var,$var,$g) \n]
+	    } else {
+		lappend res $var $data(var,$var,$g)
+	    }
+	}
+    }
+
+    return $res
 }
 
 ###############################################################################

Modified: trunk/tkabber/search.tcl
===================================================================
--- trunk/tkabber/search.tcl	2008-11-01 20:31:52 UTC (rev 1594)
+++ trunk/tkabber/search.tcl	2008-11-02 08:08:39 UTC (rev 1595)
@@ -1,15 +1,20 @@
 # $Id$
 
+package require xmpp::search
+
 namespace eval search {
-    set winid 0
     set show_all 0
 }
 
 proc search::open {xlib jid args} {
     variable winid
 
-    set sw .search$winid
+    if {![info exists winid]} {
+	set winid 0
+    }
 
+    set sw .search[incr winid]
+
     toplevel $sw -cursor watch
     wm group $sw .
     set title [::msgcat::mc "Search in %s" $jid]
@@ -27,9 +32,10 @@
 
     ButtonBox $sw.bbox -spacing 0 -padx 10 -default 0
     $sw.bbox add -text [::msgcat::mc "OK"] \
-	-command [list search::search $sw $xlib $jid] \
-        -state disabled
-    $sw.bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $sw]
+		 -command [namespace code [list Search $sw $xlib $jid false]] \
+		 -state disabled
+    $sw.bbox add -text [::msgcat::mc "Cancel"] \
+		 -command [list destroy $sw]
     pack $sw.bbox -padx 2m -pady 2m -anchor e -side bottom
 
     bind $sw <Return> [list ButtonBox::invoke $sw.bbox default]
@@ -42,32 +48,37 @@
 
     pack $sw.fields -expand yes -fill both -anchor nw -padx 2m -pady 2m
 
-    ::xmpp::sendIQ $xlib get \
-	-query [::xmpp::xml::create query \
-			-xmlns jabber:iq:search] \
-	-to $jid \
-	-command [list search::recv_fields $sw $jid]
-    
-    incr winid
+    ::xmpp::search::request $xlib $jid \
+		-command [namespace code [list RecvFields $sw $xlib $jid]]
 }
 
-proc search::recv_fields {sw jid status xml} {
-    debugmsg search "$status $xml"
+proc search::RecvFields {sw xlib jid status fields args} {
+    debugmsg search "$status $fields"
 
     if {![string equal $status ok]} {
         destroy $sw
-	MessageDlg ${sw}_err -aspect 50000 -icon error \
-	    -message [::msgcat::mc "Search: %s" [error_to_string $xml]] \
-	    -type user -buttons ok -default 0 -cancel 0
+	MessageDlg ${sw}err -aspect 50000 \
+			    -icon error \
+			    -message [::msgcat::mc "Search: %s" \
+						   [error_to_string $fields]] \
+			    -type user \
+			    -buttons ok \
+			    -default 0 \
+			    -cancel 0
 	return
     }
 
-    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
-
-    if {[string equal $xmlns jabber:iq:search]} {
-	set focus [data::fill_fields $sw.fields $subels]
+    foreach {key val} $args {
+	switch -- $key {
+	    -old {
+		$sw.bbox itemconfigure 0 \
+			 -command [namespace code [list Search $sw $xlib $jid $val]]
+	    }
+	}
     }
 
+    set focus [data::fill_fields_x $sw.fields $fields]
+
     $sw configure -cursor {}
     $sw.bbox itemconfigure 0 -state normal
 
@@ -78,26 +89,23 @@
     wm deiconify $sw
 }
 
-proc search::search {sw xlib jid} {
+proc search::Search {sw xlib jid old} {
     variable data
 
     $sw configure -cursor watch
     $sw.bbox itemconfigure 0 -state disabled
 
-    set restags [data::get_tags $sw.fields]
+    set resfields [data::get_fields $sw.fields]
 
-    ::xmpp::sendIQ $xlib set \
-	-query [::xmpp::xml::create query \
-			-xmlns jabber:iq:search \
-			-subelements $restags] \
-	-to $jid \
-	-command [list search::recv_items $sw $jid $xlib]
+    ::xmpp::search::submit $xlib $jid $resfields \
+	    -command [namespace code [list RecvItems $sw $xlib $jid $old]] \
+	    -old $old
 }
 
-proc search::recv_items {sw jid xlib status xml} {
+proc search::RecvItems {sw xlib jid old status items} {
     variable lastsort
 
-    debugmsg search "$status $xml"
+    debugmsg search "$status $items"
 
     if {![winfo exists $sw]} {
 	return
@@ -106,7 +114,7 @@
     if {![string equal $status ok]} {
 	$sw configure -cursor {}
 	$sw.bbox itemconfigure 0 -text [::msgcat::mc "Try again"] \
-	    -command [list search::search_again $sw $jid $xlib errormsg] \
+	    -command [namespace code [list SearchAgain "" $sw $jid $xlib $old errormsg]] \
 	    -state normal
 	$sw.bbox itemconfigure 1 -text [::msgcat::mc "Close"]
 
@@ -116,9 +124,10 @@
 
 	message $sw.errormsg -aspect 50000 \
 	    -text [::msgcat::mc "An error occurred when searching in %s\n\n%s" \
-				$jid [error_to_string $xml]]
+				$jid [error_to_string $items]]
 
-	pack $sw.errormsg -expand yes -fill both -after $sw.fields -anchor nw -padx 1c -pady 1c
+	pack $sw.errormsg -expand yes -fill both -after $sw.fields \
+			  -anchor nw -padx 1c -pady 1c
 	pack forget $sw.fields
 
 	return
@@ -135,10 +144,10 @@
 
     ButtonBox $rw.bbox -spacing 0 -padx 10 -default 0
     $rw.bbox add -text [::msgcat::mc "Search again"] \
-	-command "destroy [list $rw]
-		  search::search_again [list $sw] [list $jid] [list $xlib]"
-    $rw.bbox add -text [::msgcat::mc "Close"] -command "destroy [list $rw]
-							destroy [list $sw]"
+		 -command [namespace code [list SearchAgain $rw $sw $jid $xlib $old]]
+    $rw.bbox add -text [::msgcat::mc "Close"] \
+		 -command "destroy [list $rw]
+			   destroy [list $sw]"
     pack $rw.bbox -padx 2m -pady 2m -anchor e -side bottom
 
     bind $rw <Return> [list ButtonBox::invoke $rw.bbox default]
@@ -159,32 +168,17 @@
     $sww setwidget $sww.listbox
 
     set lastsort($sww.listbox) ""
-    bind $sww.listbox <Destroy> +[list [namespace current]::delete_lastsort $sww.listbox]
+    bind $sww.listbox <Destroy> +[list [namespace current]::DeleteLastsort $sww.listbox]
     
     bind $sww.listbox <3> \
-	"[namespace current]::select_and_popup_menu [list $sww.listbox] \
+	"[namespace current]::SelectAndPopupMenu [list $sww.listbox] \
 	     \[$sww.listbox nearest \[::mclistbox::convert %W -y %y\]\] \
 	     $xlib"
 
     bindscroll $sww $sww.listbox
 
-    set reported_fields [data::get_reported_fields $sw.fields]
+    set rows [FillMclistbox $rw $jid $sww.listbox $items]
 
-    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
-
-    if {[string equal $xmlns jabber:iq:search]} {
-	lassign [::xmpp::data::findForm $subels] type form
-	if {[string equal $type result]} {
-	    set parsedItems [::xmpp::data::parseResult $form]
-	} else {
-	    set reported_fields [linsert $reported_fields 0 jid]
-	    set parsedItems [parse_items $subels]
-	}
-
-	set rows [fill_mclistbox $rw $jid $sww.listbox $reported_fields \
-				 $parsedItems]
-    }
-
     if {$rows <= 0} {
 	pack forget $sww
 	message $rw.errormsg -aspect 50000 \
@@ -194,10 +188,11 @@
 	$sww.listbox configure -height [expr {$rows - ($rows % 4) + 4}]
     }
 
+    BWidget::place $rw 0 0 center
     wm deiconify $rw
 }
 
-proc search::delete_lastsort {id} {
+proc search::DeleteLastsort {id} {
     variable lastsort
 
     if {[info exists lastsort($id)]} {
@@ -205,7 +200,7 @@
     }
 }
 
-proc search::fill_mclistbox {sw jid w reported_fields items} {
+proc search::FillMclistbox {sw jid w items} {
     variable show_all
 
     set width(0) 3
@@ -224,17 +219,23 @@
 		}
 	    }
 	    reported {
-		set reported_fields {}
+		set reported {}
 		foreach {var label} $item {
-		    lappend reported_fields $var
+		    lappend reported $var
 		    set label_name($var) $label
 		}
 	    }
+	}
+    }
+
+    foreach {tag item} $items {
+	switch -- $tag {
 	    item {
 		foreach {var values} $item {
 		    foreach value $values {
 			if {![string equal $value ""]} {
-			    if {$show_all || ([lsearch -exact $reported_fields $var] >= 0)} {
+			    if {$show_all || ![info exists reported] || \
+				    [lsearch -exact $reported $var] >= 0} {
 				if {![info exists fieldcol($var)]} {
 				    set fieldcol($var) $col
 				    if {[info exists label_name($var)]} {
@@ -245,7 +246,7 @@
 				    set width($col) [string length " $l "]
 				    set name($col) $var
 				    $w column add $var -label " $l "
-				    $w label bind $var <ButtonPress-1> "[namespace current]::sort %W $var"
+				    $w label bind $var <ButtonPress-1> [namespace code [list Sort %W $var]]
 				    set lasttag $var
 
 				    incr col
@@ -264,10 +265,10 @@
 	}	
     }
 
-    finalize_mclistbox $w $row $col name data width
+    FinalizeMclistbox $w $row $col name data width
 }
 
-proc search::finalize_mclistbox {w row col n d wi} {
+proc search::FinalizeMclistbox {w row col n d wi} {
     upvar $n name
     upvar $d data
     upvar $wi width
@@ -298,30 +299,7 @@
     return $row
 }
 
-proc search::parse_items {items} {
-    set res {}
-
-    foreach item $items {
-	::xmpp::xml::split $item tag xmlns attrs cdata subels
-
-	switch -- $tag {
-	    item {
-		set itemjid [::xmpp::xml::getAttr $attrs jid]
-		set fields [list jid $itemjid]
-
-		foreach field $subels {
-		    ::xmpp::xml::split $field stag sxmlns sattrs scdata ssubels
-		    lappend fields $stag $scdata
-		}
-	    }
-	}
-	lappend res item $fields
-    }
-
-    return $res
-}
-
-proc search::sort {w tag} {
+proc search::Sort {w tag} {
     variable lastsort
 
     set data [$w get 0 end]
@@ -342,14 +320,16 @@
     eval $w insert end $result1
 }
 
-proc search::search_again {sw jid xlib {delwidget ""}} {
+proc search::SearchAgain {rw sw jid xlib old {delwidget ""}} {
+    catch {destroy $rw}
+
     $sw configure -cursor {}
-    if {![cequal $delwidget ""]} {
+    if {![string equal $delwidget ""]} {
 	pack $sw.fields -expand yes -fill both -after $sw.$delwidget -anchor nw -padx 2m -pady 2m
 	pack forget $sw.$delwidget
 
 	$sw.bbox itemconfigure 0 -text [::msgcat::mc "OK"] \
-	    -command [list search::search $sw $xlib $jid] \
+	    -command [namespace code [list Search $sw $xlib $jid $old]] \
 	    -state normal
 	$sw.bbox itemconfigure 1 -text [::msgcat::mc "Cancel"]
     } else {
@@ -358,7 +338,7 @@
     }
 }
 
-proc search::select_and_popup_menu {w index xlib} {
+proc search::SelectAndPopupMenu {w index xlib} {
 
     $w selection clear 0 end
     $w selection set $index
@@ -374,14 +354,14 @@
     tk_popup $m [winfo pointerx .] [winfo pointery .]
 }
 
-proc search::add_separator {m xlib jid} {
+proc search::AddSeparator {m xlib jid} {
     $m add separator
 }
 
 hook::add search_popup_menu_hook \
-    [namespace current]::search::add_separator 40
+    [namespace current]::search::AddSeparator 40
 hook::add search_popup_menu_hook \
-    [namespace current]::search::add_separator 50
+    [namespace current]::search::AddSeparator 50
 
 hook::add postload_hook \
     [list disco::browser::register_feature_handler jabber:iq:search \



More information about the Tkabber-dev mailing list