[Tkabber-dev] r748 - in trunk/tkabber: . plugins/chat plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Oct 7 16:00:29 MSD 2006


Author: sergei
Date: 2006-10-07 16:00:14 +0400 (Sat, 07 Oct 2006)
New Revision: 748

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/custom.tcl
   trunk/tkabber/disco.tcl
   trunk/tkabber/joingrdialog.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/plugins/chat/info_commands.tcl
   trunk/tkabber/plugins/roster/conferences.tcl
Log:
	* custom.tcl: Autosave customized variable if it has been set
	  from outside ::custom namespace. It should improve usability.

	* disco.tcl: Added connection ID to all disco operations.

	* disco.tcl, joingrdialog.tcl, messages.tcl,
	  plugins/roster/conferences.tcl: Added new hook
	  disco_node_menu_hook for popup menues in disco window. Moved
	  join conference, add conference to roster, send message menu
	  items to the hook.

	* plugins/chat/info_commands.tcl: Added roster item completion
	  to /time, /last, /vcard, and /version commands. Made
	  ::msgcat::mc handle substitutions in strings.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/ChangeLog	2006-10-07 12:00:14 UTC (rev 748)
@@ -1,3 +1,31 @@
+2006-10-07  Sergei Golovan  <sgolovan at nes.ru>
+
+	* custom.tcl: Autosave customized variable if it has been set
+	  from outside ::custom namespace. It should improve usability.
+
+	* disco.tcl: Added connection ID to all disco operations.
+
+	* disco.tcl, joingrdialog.tcl, messages.tcl,
+	  plugins/roster/conferences.tcl: Added new hook
+	  disco_node_menu_hook for popup menues in disco window. Moved
+	  join conference, add conference to roster, send message menu
+	  items to the hook.
+
+	* plugins/chat/info_commands.tcl: Added roster item completion
+	  to /time, /last, /vcard, and /version commands. Made
+	  ::msgcat::mc handle substitutions in strings.
+
+2006-10-05  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/general/headlines.tcl, trans.tcl: Removed temporary
+	  changes of system encoding because it does not allow to install
+	  Tkabber to a directory, which name contains nonenglish
+	  characters.
+
+	* ckabber.tcl, tkabber.tcl: Removed temporary changes of
+	  system encoding since [msgcat::mcload] and [option readfile]
+	  themselves use UTF-8.
+
 2006-10-02  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/headlines.tcl: Added option, which allows not

Modified: trunk/tkabber/custom.tcl
===================================================================
--- trunk/tkabber/custom.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/custom.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -114,7 +114,14 @@
 	    set var(config,$varname) [set $varname]
 	}
 	0 { }
-	1 { }
+	1 {
+	    # Store variable if it has been changed by
+	    # any procedure which is not in ::custom namespace
+	    if {[catch {info level -1} prc] || \
+		    ![regexp {^(::)*custom::} $prc]} {
+		store_vars $varname
+	    }
+	}
     }
 }
 

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/disco.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -1,5 +1,7 @@
 # $Id$
 
+##############################################################################
+
 set ::NS(disco_items) "http://jabber.org/protocol/disco#items"
 set ::NS(disco_info)  "http://jabber.org/protocol/disco#info"
 
@@ -15,6 +17,8 @@
     variable additional_items
 }
 
+##############################################################################
+
 proc disco::request_items {jid node args} {
     variable disco
 
@@ -29,15 +33,15 @@
 	}
     }
     if {![info exists connid]} {
-	set connid [jlib::route $jid]
+	return -code error "disco::request_items: -connection is mandatory"
     }
 
     switch -- $cache {
 	first -
 	only -
 	yes {
-	    if {[info exists disco(items,$jid,$node)]} {
-		set items $disco(items,$jid,$node)
+	    if {[info exists disco(items,$connid,$jid,$node)]} {
+		set items $disco(items,$connid,$jid,$node)
 		if {$handler != ""} {
 		    eval $handler [list OK $items]
 		}
@@ -60,17 +64,18 @@
 		 -vars $vars] \
 	-to $jid \
 	-connection $connid \
-	-command [list [namespace current]::parse_items $jid $node $handler]
+	-command [list [namespace current]::parse_items \
+		       $connid $jid $node $handler]
 }
 
-proc disco::parse_items {jid node handler res child} {
+proc disco::parse_items {connid jid node handler res child} {
     variable disco
 
     if {![cequal $res OK]} {
 	if {$handler != ""} {
 	    eval $handler [list ERR $child]
 	}
-	hook::run disco_items_hook $jid $node ERR $child
+	hook::run disco_items_hook $connid $jid $node ERR $child
 	return
     }
 
@@ -86,12 +91,12 @@
 		set inode  [jlib::wrapper:getattr $vars1 node]
 		set name  [jlib::wrapper:getattr $vars1 name]
 		lappend items [list jid $ijid node $inode name $name]
-		set disco(jidname,$ijid,$inode) $name
+		set disco(jidname,$connid,$ijid,$inode) $name
 	    }
 	}
     }
 
-    set disco(items,$jid,$node) $items
+    set disco(items,$connid,$jid,$node) $items
 
     debugmsg disco "ITEMS: [list $items]"
 
@@ -99,11 +104,11 @@
 	eval $handler [list OK $items]
     }
 
-    hook::run disco_items_hook $jid $node OK $items
+    hook::run disco_items_hook $connid $jid $node OK $items
 }
 
+##############################################################################
 
-
 proc disco::request_info {jid node args} {
     variable disco
 
@@ -118,22 +123,22 @@
 	}
     }
     if {![info exists connid]} {
-	set connid [jlib::route $jid]
+	return -code error "disco::request_items: -connection is mandatory"
     }
 
-    # disco(info,featured_nodes,$jid,$node) isn't cached because it isn't
-    # really reported. It's for internal use only.
-    set disco(info,featured_nodes,$jid,$node) {}
+    # disco(info,featured_nodes,$connid,$jid,$node) isn't cached because it
+    # isn't really reported. It's for internal use only.
+    set disco(info,featured_nodes,$connid,$jid,$node) {}
 
     switch -- $cache {
 	first -
 	only -
 	yes {
-	    if {[info exists disco(info,identities,$jid,$node)] && \
-		    [info exists disco(info,identities,$jid,$node)]} {
-		set identities $disco(info,identities,$jid,$node)
-		set features   $disco(info,features,$jid,$node)
-		set extras     $disco(info,extras,$jid,$node)
+	    if {[info exists disco(info,identities,$connid,$jid,$node)] && \
+		    [info exists disco(info,identities,$connid,$jid,$node)]} {
+		set identities $disco(info,identities,$connid,$jid,$node)
+		set features   $disco(info,features,$connid,$jid,$node)
+		set extras     $disco(info,extras,$connid,$jid,$node)
 		if {$handler != ""} {
 		    eval $handler [list OK $identities $features $extras]
 		}
@@ -156,10 +161,11 @@
 	     -vars $vars] \
 	-to $jid \
 	-connection $connid \
-	-command [list [namespace current]::parse_info $jid $node $handler]
+	-command [list [namespace current]::parse_info \
+		       $connid $jid $node $handler]
 }
 
-proc disco::parse_info {jid node handler res child} {
+proc disco::parse_info {connid jid node handler res child} {
     variable disco
     variable additional_nodes
 
@@ -167,7 +173,7 @@
 	if {$handler != ""} {
 	    eval $handler [list ERR $child {} {}]
 	}
-	hook::run disco_info_hook $jid $node ERR $child {} {} {}
+	hook::run disco_info_hook $connid $jid $node ERR $child {} {} {}
 	return
     }
 
@@ -199,8 +205,8 @@
 			    [concat [list jid $jid] $additional_nodes($var)]
 		    set inode [jlib::wrapper:getattr $additional_nodes($var) node]
 		    set iname [jlib::wrapper:getattr $additional_nodes($var) name]
-		    if {![info exists disco(jidname,$jid,$inode)]} {
-			set disco(jidname,$jid,$inode) $iname
+		    if {![info exists disco(jidname,$connid,$jid,$inode)]} {
+			set disco(jidname,$connid,$jid,$inode) $iname
 		    }
 		}
 	    }
@@ -213,10 +219,10 @@
 	}
     }
 
-    set disco(info,identities,$jid,$node) $identities
-    set disco(info,features,$jid,$node) $features
-    set disco(info,extras,$jid,$node) $extras
-    set disco(info,featured_nodes,$jid,$node) [lrmdups $featured_nodes]
+    set disco(info,identities,$connid,$jid,$node) $identities
+    set disco(info,features,$connid,$jid,$node) $features
+    set disco(info,extras,$connid,$jid,$node) $extras
+    set disco(info,featured_nodes,$connid,$jid,$node) [lrmdups $featured_nodes]
 
     debugmsg disco \
 	"INFO: IDENTITIES [list $identities] FEATURES [list $features]\
@@ -225,31 +231,34 @@
     if {$handler != ""} {
 	eval $handler [list OK $identities $features $extras]
     }
-    hook::run disco_info_hook $jid $node OK $identities $features $extras [lrmdups $featured_nodes]
+    hook::run disco_info_hook $connid $jid $node OK $identities $features \
+			      $extras [lrmdups $featured_nodes]
 }
 
-proc disco::get_jid_name {jid node} {
+###############################################################################
+
+proc disco::get_jid_name {connid jid node} {
     variable disco
-    if {[info exists disco(jidname,$jid,$node)]} {
-	return $disco(jidname,$jid,$node)
+    if {[info exists disco(jidname,$connid,$jid,$node)]} {
+	return $disco(jidname,$connid,$jid,$node)
     } else {
 	return ""
     }
 }
 
-proc disco::get_jid_identities {jid node} {
+proc disco::get_jid_identities {connid jid node} {
     variable disco
-    if {[info exists disco(info,identities,$jid,$node)]} {
-	return $disco(info,identities,$jid,$node)
+    if {[info exists disco(info,identities,$connid,$jid,$node)]} {
+	return $disco(info,identities,$connid,$jid,$node)
     } else {
 	return {}
     }
 }
 
-proc disco::get_jid_items {jid node} {
+proc disco::get_jid_items {connid jid node} {
     variable disco
-    if {[info exists disco(items,$jid,$node)]} {
-	return $disco(items,$jid,$node)
+    if {[info exists disco(items,$connid,$jid,$node)]} {
+	return $disco(items,$connid,$jid,$node)
     } else {
 	return {}
     }
@@ -451,6 +460,8 @@
 	    -group Hidden
 }
 
+###############################################################################
+
 proc disco::browser::open_win {jid args} {
     variable winid
     variable disco
@@ -568,12 +579,11 @@
 	history_add $bw [list $jid $node]
 
         set disco_list [update_combo_list $disco_list $jid 20]
+        set node_list [update_combo_list $node_list $node 20]
 	$bw.navigate.entry configure -values $disco_list
-	set custom::saved([namespace current]::disco_list) $disco_list
-        set node_list [update_combo_list $node_list $node 20]
 	$bw.navigate.node configure -values $node_list
-	set custom::saved([namespace current]::node_list) $node_list
-	custom::store
+	custom::store_vars [namespace current]::disco_list \
+			   [namespace current]::node_list
 
 	lappend browser(required,$bw) $jid
 	set browser(required,$bw) [lrmdups $browser(required,$bw)]
@@ -583,14 +593,16 @@
     }
 }
 
-proc disco::browser::info_receive {jid node res identities features extras featured_nodes} {
+proc disco::browser::info_receive \
+     {connid jid node res identities features extras featured_nodes} {
     variable browser
 
     if {![info exists browser(opened)]} return
 
     foreach w $browser(opened) {
 	if {[winfo exists $w] && [lcontain $browser(required,$w) $jid]} {
-	    draw_info $w $jid $node $res $identities $features $extras $featured_nodes
+	    draw_info $w $connid $jid $node $res $identities \
+		      $features $extras $featured_nodes
 	}
     }
 }
@@ -598,21 +610,22 @@
 hook::add disco_info_hook \
     [namespace current]::disco::browser::info_receive
 
-proc disco::browser::draw_info {w jid node res identities features extras featured_nodes} {
+proc disco::browser::draw_info \
+     {w connid jid node res identities features extras featured_nodes} {
     variable browser
     variable config
     global font
 
     set tw $browser(tree,$w)
 
-    set name [disco::get_jid_name $jid $node]
+    set name [disco::get_jid_name $connid $jid $node]
     set tnode [jid_to_tag [list $jid $node]]
     set parent_tag [jid_to_tag [list $jid $node]]
-    set data [list item $jid $node]
+    set data [list item $connid $jid $node]
     if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
 	set nitems 0
     } else {
-	set nitems [llength [disco::get_jid_items $jid $node]]
+	set nitems [llength [disco::get_jid_items $connid $jid $node]]
     }
     set desc [item_desc $jid $node $name $nitems]
     set icon ""
@@ -622,7 +635,7 @@
 
     if {$res != "OK"} {
 	set tnode [jid_to_tag "error info $jid $node"]
-	set data [list error_info $jid]
+	set data [list error_info $connid $jid]
 	#set name     [jlib::wrapper:getattr $identity name]
 	set desc [format [::msgcat::mc "Error getting info: %s"] \
 		      [error_to_string $identities]]
@@ -647,7 +660,7 @@
 	set name     [jlib::wrapper:getattr $identity name]
 	set category [jlib::wrapper:getattr $identity category]
 	set type     [jlib::wrapper:getattr $identity type]
-	set data [list identity $jid $node $category $type]
+	set data [list identity $connid $jid $node $category $type]
 	set desc "$name ($category/$type)"
 	set icon [item_icon $category $type]
 	
@@ -661,7 +674,7 @@
 	lassign $extra var label values
 	set tnode [jid_to_tag "extra $var $jid $node"]
 	lappend extranodes $tnode
-	set data [list extra $var $jid $node]
+	set data [list extra $var $connid $jid $node]
 	set value [join $values ", "]
 	set desc "$label ($var): $value"
 	set icon ""
@@ -676,7 +689,7 @@
 	set var [jlib::wrapper:getattr $feature var]
 	set tnode [jid_to_tag "feature $feature $jid $node"]
 	lappend featurenodes $tnode
-	set data [list feature $jid $node $feature $category $type]
+	set data [list feature $connid $jid $node $feature $category $type]
 	set desc $var
 	if {[info exists browser(feature_handler_desc,$var)]} {
 	    catch { array unset tmp }
@@ -701,11 +714,11 @@
 
 	set name [jlib::wrapper:getattr $item name]
 	set tnode [jid_to_tag [list $ijid $node]]
-	set data [list item $ijid $node]
+	set data [list item $connid $ijid $node]
 	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
 	    set nitems 0
 	} else {
-	    set nitems [llength [disco::get_jid_items $ijid $node]]
+	    set nitems [llength [disco::get_jid_items $connid $ijid $node]]
 	}
 	set desc [item_desc $ijid $node $name $nitems]
 	set icon ""
@@ -723,14 +736,14 @@
     reorder_node $tw $parent_tag
 }
 
-proc disco::browser::items_receive {jid node res items} {
+proc disco::browser::items_receive {connid jid node res items} {
     variable browser
 
     if {![info exists browser(opened)]} return
 
     foreach w $browser(opened) {
 	if {[winfo exists $w] && [lcontain $browser(required,$w) $jid]} {
-	    draw_items $w $jid $node $res $items
+	    draw_items $w $connid $jid $node $res $items
 	}
     }
 }
@@ -738,7 +751,7 @@
 hook::add disco_items_hook \
     [namespace current]::disco::browser::items_receive
 
-proc disco::browser::draw_items {w jid node res items} {
+proc disco::browser::draw_items {w connid jid node res items} {
     variable browser
     variable config
     global font
@@ -747,13 +760,13 @@
 
     set parent_tag [jid_to_tag [list $jid $node]]
 
-    set name [disco::get_jid_name $jid $node]
+    set name [disco::get_jid_name $connid $jid $node]
     set tnode [jid_to_tag [list $jid $node]]
-    set data [list item $jid $node]
+    set data [list item $connid $jid $node]
     if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
 	set nitems 0
     } else {
-	set nitems [llength [disco::get_jid_items $jid $node]]
+	set nitems [llength [disco::get_jid_items $connid $jid $node]]
     }
     set desc [item_desc $jid $node $name $nitems]
     set icon ""
@@ -763,12 +776,12 @@
 
     if {$res != "OK"} {
 	# HACK
-	if {[info exists ::disco::disco(info,featured_nodes,$jid,$node)] && \
-	    ![lempty $::disco::disco(info,featured_nodes,$jid,$node)]} {
+	if {[info exists ::disco::disco(info,featured_nodes,$connid,$jid,$node)] && \
+	    ![lempty $::disco::disco(info,featured_nodes,$connid,$jid,$node)]} {
 	    set items {}
 	} else {
 	    set tnode [jid_to_tag "error items $jid $node"]
-	    set data [list error_items $jid]
+	    set data [list error_items $connid $jid]
 	    #set name     [jlib::wrapper:getattr $identity name]
 	    set desc [::msgcat::mc "Error getting items: %s" \
 				   [error_to_string $items]]
@@ -788,8 +801,8 @@
     # (if the service's features change then this node list may be
     # incorrect)
     set itemnodes {}
-    if {[info exists ::disco::disco(info,featured_nodes,$jid,$node)]} {
-	foreach item $::disco::disco(info,featured_nodes,$jid,$node) {
+    if {[info exists ::disco::disco(info,featured_nodes,$connid,$jid,$node)]} {
+	foreach item $::disco::disco(info,featured_nodes,$connid,$jid,$node) {
 	    set ijid [jlib::wrapper:getattr $item jid]
 	    set inode [jlib::wrapper:getattr $item node]
 	    lappend itemnodes [jid_to_tag [list $ijid $inode]]
@@ -802,11 +815,11 @@
 
 	set name [jlib::wrapper:getattr $item name]
 	set tnode [jid_to_tag [list $ijid $node]]
-	set data [list item $ijid $node]
+	set data [list item $connid $ijid $node]
 	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
 	    set nitems 0
 	} else {
-	    set nitems [llength [disco::get_jid_items $ijid $node]]
+	    set nitems [llength [disco::get_jid_items $connid $ijid $node]]
 	}
 	set desc [item_desc $ijid $node $name $nitems]
 	set icon ""
@@ -835,7 +848,7 @@
 
     if {$res != "OK"} {
 	set node [jid_to_tag "error negotiate $parent"]
-	set data [list error_negotiate $parent $jid]
+	set data [list error_negotiate $parent $connid $jid]
 	#set name     [jlib::wrapper:getattr $identity name]
 	set desc [format [::msgcat::mc "Error negotiate: %s"] \
 		      [error_to_string $opts]]
@@ -903,11 +916,11 @@
 	lassign [$tw itemcget $sn -data] kind
 	switch -- $kind {
 	    error_items -
-	    item     {lappend items      $sn}
-	    error_info -
-	    identity {lappend identities $sn}
-	    feature  {lappend features   $sn}
-	    extra    {lappend extras     $sn}
+	    item        {lappend items      $sn}
+	    error_info  -
+	    identity    {lappend identities $sn}
+	    feature     {lappend features   $sn}
+	    extra       {lappend extras     $sn}
 	}
     }
     if {$order == {}} {
@@ -979,11 +992,11 @@
     set data2 [lassign $data type]
     switch -- $type {
 	item {
-	    lassign $data2 jid node
+	    lassign $data2 connid jid node
 	    goto $bw $jid $node
 	}
 	feature {
-	    lassign $data2 jid node feature category subtype
+	    lassign $data2 connid jid node feature category subtype
 	    set var [jlib::wrapper:getattr $feature var]
 	    debugmsg disco $jid
 	    if {$var != ""} {
@@ -991,14 +1004,14 @@
 		    if {$browser(feature_handler_node,$var)} {
 			eval $browser(feature_handler,$var) [list $jid $node \
 			    -category $category -type $subtype \
-			    -connection $browser(connid,$bw)]
+			    -connection $connid]
 		    } else {
 			eval $browser(feature_handler,$var) [list $jid \
 			    -category $category -type $subtype \
-			    -connection $browser(connid,$bw)]
+			    -connection $connid]
 		    }
 		} else {
-		    negotiate_feature $tw $browser(connid,$bw) $jid $tnode $var
+		    negotiate_feature $tw $connid $jid $tnode $var
 		}
 	    }
 	}
@@ -1008,7 +1021,8 @@
 proc disco::browser::textpopup {bw tnode} {
     variable browser
 
-    if {[winfo exists [set m .discopopupmenu]]} {
+    set m .discopopupmenu
+    if {[winfo exists $m]} {
 	destroy $m
     }
     menu $m -tearoff 0
@@ -1017,65 +1031,62 @@
     set data [$tw itemcget $tnode -data]
     set data2 [lassign $data type]
 
+    # Parent node category shouldn't impact node action in theory,
+    # but sometimes (e.g. when joining MUC group) it's useful.
+    set tparentnode [$tw parent $tnode]
+    set parentdata {}
+    catch {set parentdata [$tw itemcget $tparentnode -data]}
+
+    hook::run disco_node_menu_hook $m $bw $tnode $data $parentdata
+
+    tk_popup $m [winfo pointerx .] [winfo pointery .]
+}
+
+proc disco::browser::textpopup_menu_setup {m bw tnode data parentdata} {
+    variable browser
+    set tw $browser(tree,$bw)
+
+    if {[$m index end] != "none"} {
+	$m add separator
+    }
+
+    set tparentnode [$tw parent $tnode]
+
+    set data2 [lassign $data type]
     switch -- $type {
-	identity {
-	}
-
 	feature {
 	    $m add command -label [::msgcat::mc "Browse"] \
 		-command [list [namespace current]::browser_action browse $bw $tnode]
+	    $m add separator
 	}
-
 	item {
-	    lassign $data2 jid node
-	    set identities [[namespace parent]::get_jid_identities $jid $node]
-	    # TODO: use all identities
-	    set category [jlib::wrapper:getattr [lindex $identities 0] category]
-	    switch -- $category {
-		client {
-		    message::subject_menu $m $browser(connid,$bw) \
-			   [lindex $data 1] message
-		    tk_popup $m [winfo pointerx .] [winfo pointery .]
-		    return
-		}
-
-		conference {
-		    if {[string first @ [set headjid [lindex $data 1]]] > 0} {
-			$m add command -label [::msgcat::mc "Join group..."] \
-			    -command [list join_group_dialog \
-					   -server [server_from_jid $headjid] \
-					   -group [node_from_jid $headjid] \
-					   -connection $browser(connid,$bw)]
-			$m add command -label [::msgcat::mc "Add conference..."] \
-			    -command [list plugins::conferences::add_conference_dialog \
-					   -group [node_from_jid $headjid] \
-					   -server [server_from_jid $headjid] \
-					   -connection $browser(connid,$bw)]
-			$m add separator
-		    }
-		}
-
-		default {
-		}
-	    }
 	    $m add command -label [::msgcat::mc "Browse"] \
 		-command [list [namespace current]::browser_action browse $bw $tnode]
 	    $m add command -label [::msgcat::mc "Sort items by name"] \
 		-command [list [namespace current]::browser_action sort $bw $tnode]
 	    $m add command -label [::msgcat::mc "Sort items by JID/node"] \
 		-command [list [namespace current]::browser_action sortjid $bw $tnode]
+
+	    $m add separator
+	    if {$tparentnode == "root"} {
+		set label [::msgcat::mc "Delete current node and subnodes"]
+	    } else {
+		set label [::msgcat::mc "Delete subnodes"]
+	    }
+	    $m add command -label $label \
+		-command [list [namespace current]::clear $bw $tnode]
 	}
+	default {
+	}
     }
 
-    $m add separator
-    $m add command -label [::msgcat::mc "Clear"] \
-	-command [list [namespace current]::clear $bw $tnode]
-    $m add command -label [::msgcat::mc "Clear All"] \
+    $m add command -label [::msgcat::mc "Clear window"] \
 	-command [list [namespace current]::clearall $bw]
-
-    tk_popup $m [winfo pointerx .] [winfo pointery .]
 }
 
+hook::add disco_node_menu_hook \
+	  [namespace current]::disco::browser::textpopup_menu_setup 100
+
 proc disco::browser::clearall {bw} {
     variable browser
     set tw $browser(tree,$bw)
@@ -1101,9 +1112,9 @@
 	foreach sn [$tw nodes $tnode] {
 	    $tw delete $sn
 	}
-	lassign [$tw itemcget $tnode -data] type jid node
+	lassign [$tw itemcget $tnode -data] type connid jid node
 	if {$type == "item"} {
-	    set name [disco::get_jid_name $jid $node]
+	    set name [disco::get_jid_name $connid $jid $node]
 	    set desc [item_desc $jid $node $name 0]
 	    $tw itemconfigure $tnode -text $desc
 	}
@@ -1132,10 +1143,10 @@
 		set data [lassign [$tw itemcget $child -data] type]
 		switch -- $type {
 		    item {
-			lassign $data jid node
+			lassign $data connid jid node
 			lappend items \
 			    [list $child \
-				  [[namespace parent]::get_jid_name $jid $node]]
+				  [disco::get_jid_name $connid $jid $node]]
 		    }
 		}
             }
@@ -1158,10 +1169,10 @@
 		set data [lassign [$tw itemcget $child -data] type]
 		switch -- $type {
 		    item {
-			lassign $data jid node
+			lassign $data connid jid node
 			if {$node != {}} {
 			    lappend items_with_nodes \
-				[list $child [join $data "\u0000"]]
+				[list $child "$jid\u0000$node"]
 			} else {
 			    lappend items [list $child $jid]
 			}
@@ -1196,7 +1207,7 @@
 	return [list $bw:$node ""]
     }
 
-    lassign $data type jid category subtype name version
+    lassign $data type connid jid category subtype name version
     if {$type == "jid"} {
 	return [list $bw:$node \
 		     [item_balloon_text $jid $category $subtype $name $version]]
@@ -1216,7 +1227,7 @@
 proc disco::browser::get_category_type {t tnode} {
     foreach child [$t nodes $tnode] {
 	set data [$t itemcget $child -data]
-        set data2 [lassign $data type jid node]
+        set data2 [lassign $data type connid jid node]
 	if {$type == "identity"} {
 	    return $data2
 	}
@@ -1225,9 +1236,8 @@
 }
 
 proc disco::browser::draginitcmd {bw t tnode top} {
-    set connid browser(connid,$bw)
     set data [$t itemcget $tnode -data]
-    set data2 [lassign $data type jid node]
+    set data2 [lassign $data type connid jid node]
 
     if {$type == "item"} {
 	if {[set img [$t itemcget $tnode -image]] != ""} {
@@ -1280,8 +1290,8 @@
     $bw.navigate.node.e delete 0 end
     $bw.navigate.node.e insert 0 $newnode
 
+    disco::request_info $newjid $newnode -connection $browser(connid,$bw)
     disco::request_items $newjid $newnode -connection $browser(connid,$bw)
-    disco::request_info $newjid $newnode -connection $browser(connid,$bw)
 }
 
 proc disco::browser::history_add {bw jid} {

Modified: trunk/tkabber/joingrdialog.tcl
===================================================================
--- trunk/tkabber/joingrdialog.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/joingrdialog.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -192,3 +192,39 @@
     return $groupchats(nick,$group)
 }
 
+###############################################################################
+
+proc joingroup_disco_node_menu_setup {m bw tnode data parentdata} {
+    lassign $data type connid jid node
+    lassign $parentdata ptype pconnid pjid pnode
+    switch -- $type {
+	item {
+	    set identities [disco::get_jid_identities $connid $jid $node]
+	    set pidentities [disco::get_jid_identities $pconnid $pjid $pnode]
+
+	    # JID with resource is not a room JID
+	    if {[node_and_server_from_jid $jid] != $jid} return
+
+	    if {[lempty $identities]} {
+		set identities $pidentities
+	    }
+
+	    foreach id $identities {
+		if {[jlib::wrapper:getattr $id category] == "conference"} {
+		    $m add command -label [::msgcat::mc "Join group..."] \
+			-command [list join_group_dialog \
+				       -server [server_from_jid $jid] \
+				       -group [node_from_jid $jid] \
+				       -connection $connid]
+		    break
+		}
+	    }
+	}
+    }
+}
+
+hook::add disco_node_menu_hook \
+	  [namespace current]::joingroup_disco_node_menu_setup 45
+
+###############################################################################
+

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/messages.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -707,6 +707,27 @@
 
 ###############################################################################
 
+proc message::disco_popup_menu {m bw tnode data parentdata} {
+    lassign $data type connid jid node
+    switch -- $type {
+	item {
+	    set identities [disco::get_jid_identities $connid $jid $node]
+
+	    foreach id $identities {
+		if {[jlib::wrapper:getattr $id category] == "client"} {
+		    subject_menu $m $connid $jid message
+		    break
+		}
+	    }
+	}
+    }
+
+}
+
+hook::add disco_node_menu_hook message::disco_popup_menu
+
+###############################################################################
+
 proc message::subject_menu {m connid jid type} {
     if {[winfo exists $m]} {
         destroy $m          

Modified: trunk/tkabber/plugins/chat/info_commands.tcl
===================================================================
--- trunk/tkabber/plugins/chat/info_commands.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/plugins/chat/info_commands.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -1,8 +1,16 @@
 # $Id$
+#
+# Plugin implements commands /time, /last, /vcard, /version in chat
+# and groupchat windows.
+#
 
+##############################################################################
+
 namespace eval chatinfo {
 
-    custom::defgroup VCard [::msgcat::mc "vCard display options in chat windows."] -group Chat
+    custom::defgroup VCard \
+	[::msgcat::mc "vCard display options in chat windows."] \
+	-group Chat
     
     set vcard_defs [list fn        [::msgcat::mc "Full Name"]		    1 \
 			 family    [::msgcat::mc "Family Name"]		    1 \
@@ -45,13 +53,13 @@
 
     foreach {opt name default} $vcard_defs {
 	custom::defvar options($opt) $default \
-            [format \
-		 [::msgcat::mc "Display %s in chat window when using /vcard command."] \
+	    [::msgcat::mc "Display %s in chat window when using /vcard command." \
 		 $name] \
 	    -type boolean -group VCard
     }
 }
 
+##############################################################################
 
 proc chatinfo::handle_info_commands {chatid user body type} {
 
@@ -106,13 +114,15 @@
 hook::add chat_send_message_hook \
     [namespace current]::chatinfo::handle_info_commands 15
 
+##############################################################################
 
 proc chatinfo::roster_lookup {connid name} {
     set ret {}
     set ret1 {}
-    foreach i [array names ::roster::roster name,$connid,*] {
-	if {[cequal $::roster::roster($i) $name]} {
-	    set bare_jid [join [lrange [split $i ","] 2 end] ","]
+    foreach jid [roster::get_jids $connid] {
+	set rname [roster::get_label $connid $jid]
+	if {[cequal $rname $name]} {
+	    set bare_jid [node_and_server_from_jid $jid]
 	    set full_jids [::get_jids_of_user $connid $bare_jid]
 	    if {![cequal $full_jids {}]} {
 		set ret [concat $ret $full_jids]
@@ -122,21 +132,41 @@
 	    lappend ret1 $bare_jid
 	}
     }
-    return [list $ret $ret1]
+    return [list [lsort -unique $ret] [lsort -unique $ret1]]
 }
 
+##############################################################################
 
 proc chatinfo::info_commands_comps {chatid compsvar wordstart line} {
     upvar 0 $compsvar comps
+
+    set commands [list "/time " "/last " "/vcard " "/version "]
     
     if {!$wordstart} {
-	lappend comps {/time } {/last } {/vcard } {/version }
+	set comps [concat $comps $commands]
+    } elseif {![chat::is_groupchat $chatid]} {
+	set q 0
+	foreach cmd $commands {
+	    if {[string equal -length [string length $cmd] $cmd $line]} {
+		set q 1
+		break
+	    }
+	}
+	if {!$q} return
+
+	set connid [chat::get_connid $chatid]
+	set names {}
+	foreach jid [roster::get_jids $connid] {
+	    lappend names "[roster::get_label $connid $jid] "
+	}
+	set comps [concat $comps [lsort -unique $names]]
     }
 }
 
 hook::add generate_completions_hook \
     [namespace current]::chatinfo::info_commands_comps
 
+##############################################################################
 
 proc chatinfo::request_iq {type connid chatid jid} {
     jlib::send_iq get \
@@ -147,6 +177,7 @@
 	-command [list [namespace current]::parse_info_iq$type $chatid $jid]
 }
 
+##############################################################################
 
 proc chatinfo::request_vcard {connid chatid jid} {
     jlib::send_iq get \
@@ -157,6 +188,7 @@
 	-command [list [namespace current]::parse_info_vcard $chatid $jid]
 }
 
+##############################################################################
 
 proc chatinfo::whois {chatid jid} {
     set connid [chat::get_connid $chatid]
@@ -168,6 +200,7 @@
     }
 }
 
+##############################################################################
 
 proc chatinfo::parse_info_iqtime {chatid jid res child} {
 
@@ -178,7 +211,7 @@
     set rjid [whois $chatid $jid]
     if {![cequal $res OK]} {
 	chat::add_message $chatid $jid error \
-	    [format [::msgcat::mc "time %s%s: %s"] $jid $rjid [error_to_string $child]] {}
+	    [::msgcat::mc "time %s%s: %s" $jid $rjid [error_to_string $child]] {}
 	return
     }
 
@@ -187,7 +220,7 @@
     if {[cequal [jlib::wrapper:getattr $vars xmlns] jabber:iq:time]} {
 	userinfo::parse_iqtime_item $jid $children
     }
-    set message [format [::msgcat::mc "time %s%s:"] $jid $rjid]
+    set message [::msgcat::mc "time %s%s:" $jid $rjid]
     foreach {i j} [list time [::msgcat::mc "Time:"] \
 		    tz   [::msgcat::mc "Time Zone:"] \
 		    utc  [::msgcat::mc "UTC:"]] {
@@ -199,6 +232,7 @@
     chat::add_message $chatid $jid info $message {}
 }
 
+##############################################################################
 
 proc chatinfo::parse_info_iqlast {chatid jid res child} {
 
@@ -209,7 +243,7 @@
     set rjid [whois $chatid $jid]
     if {![cequal $res OK]} {
 	chat::add_message $chatid $jid error \
-	    [format [::msgcat::mc "last %s%s: %s"] $jid $rjid [error_to_string $child]] {}
+	    [::msgcat::mc "last %s%s: %s" $jid $rjid [error_to_string $child]] {}
 	return
     }
 
@@ -220,7 +254,7 @@
 	    [format_time [jlib::wrapper:getattr $vars seconds]]
 	set ::userinfo::userinfo(lastdesc,$jid) $chdata
     }
-    set message [format [::msgcat::mc "last %s%s:"] $jid $rjid]
+    set message [::msgcat::mc "last %s%s:" $jid $rjid]
     foreach {i j} [list lastseconds [::msgcat::mc "Interval:"] \
 		    lastdesc    [::msgcat::mc "Description:"]] {
 	if {[info exists userinfo::userinfo($i,$jid)] && \
@@ -231,6 +265,7 @@
     chat::add_message $chatid $jid info $message {}
 }
 
+##############################################################################
 
 proc chatinfo::parse_info_iqversion {chatid jid res child} {
 
@@ -241,7 +276,7 @@
     set rjid [whois $chatid $jid]
     if {![cequal $res OK]} {
 	chat::add_message $chatid $jid error \
-	    [format [::msgcat::mc "version %s%s: %s"] $jid $rjid [error_to_string $child]] {}
+	    [::msgcat::mc "version %s%s: %s" $jid $rjid [error_to_string $child]] {}
 	return
     }
 
@@ -251,7 +286,7 @@
 	userinfo::parse_iqversion_item $jid $children
     }
 
-    set message [format [::msgcat::mc "version %s%s:"] $jid $rjid]
+    set message [::msgcat::mc "version %s%s:" $jid $rjid]
     foreach {i j} [list clientname    [::msgcat::mc "Client:"] \
 		    clientversion [::msgcat::mc "Version:"] \
 		    os            [::msgcat::mc "OS:"]] {
@@ -263,6 +298,7 @@
     chat::add_message $chatid $jid info $message {}
 }
 
+##############################################################################
 
 proc chatinfo::parse_info_vcard {chatid jid res child} {
     variable options
@@ -275,7 +311,7 @@
     set rjid [whois $chatid $jid]
     if {![cequal $res OK]} {
 	chat::add_message $chatid $jid error \
-	    [format [::msgcat::mc "vcard %s%s: %s"] $jid $rjid [error_to_string $child]] {}
+	    [::msgcat::mc "vcard %s%s: %s" $jid $rjid [error_to_string $child]] {}
 	return
     }
 
@@ -284,7 +320,7 @@
     foreach item $children {
 	userinfo::parse_vcard_item $jid $item
     }
-    set message [format [::msgcat::mc "vcard %s%s:"] $jid $rjid]
+    set message [::msgcat::mc "vcard %s%s:" $jid $rjid]
     foreach {def name ignore} $vcard_defs) {
 	if {$options($def) && \
 		[info exists userinfo::userinfo($def,$jid)] && \
@@ -295,3 +331,5 @@
     chat::add_message $chatid $jid info $message {}
 }
 
+##############################################################################
+

Modified: trunk/tkabber/plugins/roster/conferences.tcl
===================================================================
--- trunk/tkabber/plugins/roster/conferences.tcl	2006-10-05 21:23:51 UTC (rev 747)
+++ trunk/tkabber/plugins/roster/conferences.tcl	2006-10-07 12:00:14 UTC (rev 748)
@@ -845,3 +845,37 @@
 
 ###############################################################################
 
+proc conferences::disco_node_menu_setup {m bw tnode data parentdata} {
+    lassign $data type connid jid node
+    lassign $parentdata ptype pconnid pjid pnode
+    switch -- $type {
+	item {
+	    set identities [disco::get_jid_identities $connid $jid $node]
+	    set pidentities [disco::get_jid_identities $pconnid $pjid $pnode]
+
+	    # JID with resource is not a room JID
+	    if {[node_and_server_from_jid $jid] != $jid} return
+
+	    if {[lempty $identities]} {
+		set identities $pidentities
+	    }
+
+	    foreach id $identities {
+		if {[jlib::wrapper:getattr $id category] == "conference"} {
+		    $m add command -label [::msgcat::mc "Add conference to roster..."] \
+			-command [list [namespace current]::add_conference_dialog \
+				       -group [node_from_jid $jid] \
+				       -server [server_from_jid $jid] \
+				       -connection $connid]
+		    break
+		}
+	    }
+	}
+    }
+}
+
+hook::add disco_node_menu_hook \
+	  [namespace current]::conferences::disco_node_menu_setup 50
+
+###############################################################################
+



More information about the Tkabber-dev mailing list