[Tkabber-dev] r730 - in trunk/tkabber: . ifacetk msgs plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Sep 24 21:43:18 MSD 2006


Author: sergei
Date: 2006-09-24 21:43:13 +0400 (Sun, 24 Sep 2006)
New Revision: 730

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/disco.tcl
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/msgs/ru.msg
   trunk/tkabber/plugins/general/xcommands.tcl
Log:
	* ifacetk/iface.tcl: In UNIX WM_SAVE_YOURSELF can be called several
	  times. So, call quit only on windows, where WM_SAVE_YOURSELF
	  means end of windows session. Also trap SIGTERM (call quit)
	  when Tclx is available (thanks to Konstantin Khomoutov).

	* disco.tcl, plugins/general/xcommands.tcl: Show a special item for
	  some (registered) features even if the remote service has not
	  provided it. Especially, always show
	  http://jabber.org/protocol/commands node if there is a
	  correspondent feature. It helps for example to control Psi
	  client remotely.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-09-24 10:39:21 UTC (rev 729)
+++ trunk/tkabber/ChangeLog	2006-09-24 17:43:13 UTC (rev 730)
@@ -13,6 +13,18 @@
 	* ifaceck/iface.tcl, ifacetk/iface.tcl, splash.tcl,
 	  doc/tkabber.xml, doc/tkabber.html: Changed Tkabber home page.
 
+	* ifacetk/iface.tcl: In UNIX WM_SAVE_YOURSELF can be called several
+	  times. So, call quit only on windows, where WM_SAVE_YOURSELF
+	  means end of windows session. Also trap SIGTERM (call quit)
+	  when Tclx is available (thanks to Konstantin Khomoutov).
+
+	* disco.tcl, plugins/general/xcommands.tcl: Show a special item for
+	  some (registered) features even if the remote service has not
+	  provided it. Especially, always show
+	  http://jabber.org/protocol/commands node if there is a
+	  correspondent feature. It helps for example to control Psi
+	  client remotely.
+
 2006-09-23  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/filetransfer/si.tcl, plugins/si/ibb.tcl,

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2006-09-24 10:39:21 UTC (rev 729)
+++ trunk/tkabber/disco.tcl	2006-09-24 17:43:13 UTC (rev 730)
@@ -12,6 +12,7 @@
     variable supported_nodes
     variable supported_features {}
     variable root_nodes {}
+    variable additional_items
 }
 
 proc disco::request_items {jid node args} {
@@ -120,6 +121,10 @@
 	set connid [jlib::route $jid]
     }
 
+    # 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) {}
+
     switch -- $cache {
 	first -
 	only -
@@ -156,18 +161,20 @@
 
 proc disco::parse_info {jid node handler res child} {
     variable disco
+    variable additional_nodes
 
     if {![cequal $res OK]} {
 	if {$handler != ""} {
 	    eval $handler [list ERR $child {} {}]
 	}
-	hook::run disco_info_hook $jid $node ERR $child {} {}
+	hook::run disco_info_hook $jid $node ERR $child {} {} {}
 	return
     }
 
     set identities {}
     set features {}
     set extras {}
+    set featured_nodes {}
 
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
@@ -187,6 +194,15 @@
 		    set var [jlib::wrapper:getattr $vars1 type]
 		}
 		lappend features [list var $var]
+		if {($node == "") && [info exists additional_nodes($var)]} {
+		    lappend featured_nodes \
+			    [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
+		    }
+		}
 	    }
 	    default {
 		if {[jlib::wrapper:getattr $vars1 xmlns] == "jabber:x:data" && \
@@ -200,15 +216,16 @@
     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]
 
     debugmsg disco \
 	"INFO: IDENTITIES [list $identities] FEATURES [list $features]\
-	 EXTRAS [list $extras]"
+	 EXTRAS [list $extras] FEATURED NODES [list [lrmdups $featured_nodes]]"
 
     if {$handler != ""} {
 	eval $handler [list OK $identities $features $extras]
     }
-    hook::run disco_info_hook $jid $node OK $identities $features $extras
+    hook::run disco_info_hook $jid $node OK $identities $features $extras [lrmdups $featured_nodes]
 }
 
 proc disco::get_jid_name {jid node} {
@@ -240,6 +257,14 @@
 
 ###############################################################################
 
+proc disco::register_featured_node {feature node name} {
+    variable additional_nodes
+
+    set additional_nodes($feature) [list node $node name $name]
+}
+
+###############################################################################
+
 proc disco::info_query_get_handler {connid from lang child} {
     variable supported_nodes
     variable node_handlers
@@ -558,19 +583,19 @@
 	lappend browser(required,$bw) $jid
 	set browser(required,$bw) [lrmdups $browser(required,$bw)]
 
+	disco::request_info $jid $node -connection $browser(connid,$bw)
 	disco::request_items $jid $node -connection $browser(connid,$bw)
-	disco::request_info $jid $node -connection $browser(connid,$bw)
     }
 }
 
-proc disco::browser::info_receive {jid node res identities features extras} {
+proc disco::browser::info_receive {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
+	    draw_info $w $jid $node $res $identities $features $extras $featured_nodes
 	}
     }
 }
@@ -578,7 +603,7 @@
 hook::add disco_info_hook \
     [namespace current]::disco::browser::info_receive
 
-proc disco::browser::draw_info {w jid node res identities features extras} {
+proc disco::browser::draw_info {w jid node res identities features extras featured_nodes} {
     variable browser
     variable config
     global font
@@ -617,7 +642,6 @@
 	return
     }
 
-
     set identitynodes {}
 
     set category ""
@@ -674,6 +698,29 @@
 	    -fill $config(featurecolor)
     }
 
+    # Draw all implicit item nodes, which are not received explicitly
+    # (don't overwrite node because it can have different name)
+    foreach item $featured_nodes {
+	set ijid [jlib::wrapper:getattr $item jid]
+	set node [jlib::wrapper:getattr $item node]
+
+	set name [jlib::wrapper:getattr $item name]
+	set tnode [jid_to_tag [list $ijid $node]]
+	set data [list item $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 desc [item_desc $ijid $node $name $nitems]
+	set icon ""
+
+	if {![$tw exists $tnode]} {
+	    add_line $tw $parent_tag $tnode $icon $desc $data -font $font \
+		     -fill $config(fill)
+	}
+    }
+
     remove_old $tw $parent_tag identity $identitynodes
     remove_old $tw $parent_tag extra    $extranodes
     remove_old $tw $parent_tag feature  $featurenodes
@@ -720,22 +767,39 @@
 	-fill $config(fill)
 
     if {$res != "OK"} {
-	set tnode [jid_to_tag "error items $jid $node"]
-	set data [list error_items $jid]
-	#set name     [jlib::wrapper:getattr $identity name]
-	set desc [format [::msgcat::mc "Error getting items: %s"] \
-		      [error_to_string $items]]
-	set icon ""
+	# HACK
+	if {[info exists ::disco::disco(info,featured_nodes,$jid,$node)] && \
+	    ![lempty $::disco::disco(info,featured_nodes,$jid,$node)]} {
+	    set items {}
+	} else {
+	    set tnode [jid_to_tag "error items $jid $node"]
+	    set data [list error_items $jid]
+	    #set name     [jlib::wrapper:getattr $identity name]
+	    set desc [::msgcat::mc "Error getting items: %s" \
+				   [error_to_string $items]]
+	    set icon ""
 	
-	add_line $tw $parent_tag $tnode $icon $desc $data -font $font \
-	    -fill $config(fill)
+	    add_line $tw $parent_tag $tnode $icon $desc $data -font $font \
+		     -fill $config(fill)
 
-	remove_old $tw $parent_tag item [list $tnode]
-	reorder_node $tw $parent_tag
-	return
+	    remove_old $tw $parent_tag item [list $tnode]
+	    reorder_node $tw $parent_tag
+	    return
+	}
     }
 
+    # HACK
+    # Don't remove nodes, which are drawn after disco#info query
+    # (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) {
+	    set ijid [jlib::wrapper:getattr $item jid]
+	    set inode [jlib::wrapper:getattr $item node]
+	    lappend itemnodes [jid_to_tag [list $ijid $inode]]
+	}
+    }
 
     foreach item $items {
 	set ijid [jlib::wrapper:getattr $item jid]

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2006-09-24 10:39:21 UTC (rev 729)
+++ trunk/tkabber/ifacetk/iface.tcl	2006-09-24 17:43:13 UTC (rev 730)
@@ -118,7 +118,7 @@
 
 option add *errorForeground red widgetDefault
 
-wm protocol . WM_SAVE_YOURSELF quit
+wm protocol . WM_SAVE_YOURSELF session_checkpoint
 
 wm protocol . WM_DELETE_WINDOW \
    [list [namespace current]::ifacetk::wm_delete_window]
@@ -1371,3 +1371,17 @@
 	-message $message -type user -buttons ok -default 0 -cancel 0
 }
 
+# This proc should be called by WM_SAVE_YOURSELF protocol callback.
+# On Windows (and Tk >= 8.4.13) this means WM_QUERYENDSESSION (so we should quit),
+# on Unix, an X session manager may call this repeatedly.
+proc session_checkpoint {} {
+	::hook::run save_yourself_hook
+	if {$tcl_platform(platform) == "windows"} quit
+}
+
+# Trap SIGTERM to quit gracefully on Unix when Tclx is available:
+if {$tcl_platform(platform) == "unix" 
+	&& ![catch {package require Tclx}]} {
+	signal trap SIGTERM quit
+}
+

Modified: trunk/tkabber/msgs/ru.msg
===================================================================
--- trunk/tkabber/msgs/ru.msg	2006-09-24 10:39:21 UTC (rev 729)
+++ trunk/tkabber/msgs/ru.msg	2006-09-24 17:43:13 UTC (rev 730)
@@ -157,6 +157,7 @@
     "Использовать цветные сообщения в окнах разговора."
 ::msgcat::mcset ru "Command to be runned when you click a URL in a message.  '%s' will be replaced with this URL (e.g. \"galeon -n %s\")." \
     "Команда, которая будет выполнена при нажатии на URL в сообщении. Вместо '%s' будет подставлен URL (например, \"galeon -n %s\")."
+::msgcat::mcset ru "Commands" "Команды"
 ::msgcat::mcset ru "Complete nickname" "Дополнить псевдоним"
 ::msgcat::mcset ru "Compression" "Сжатие"
 ::msgcat::mcset ru "Compression negotiation failed" "Согласовать сжатие не удалось"

Modified: trunk/tkabber/plugins/general/xcommands.tcl
===================================================================
--- trunk/tkabber/plugins/general/xcommands.tcl	2006-09-24 10:39:21 UTC (rev 729)
+++ trunk/tkabber/plugins/general/xcommands.tcl	2006-09-24 17:43:13 UTC (rev 730)
@@ -454,6 +454,8 @@
     disco::browser::register_feature_handler $::NS(commands) \
 	[namespace current]::execute -node 1 \
 	-desc [list automation [::msgcat::mc "Execute command"]]
+    disco::register_featured_node $::NS(commands) $::NS(commands) \
+				  [::msgcat::mc "Commands"]
 }
 
 hook::add postload_hook [namespace current]::xcommands::register_namespace



More information about the Tkabber-dev mailing list