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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Apr 2 23:50:31 MSD 2009


Author: sergei
Date: 2009-04-02 23:50:30 +0400 (Thu, 02 Apr 2009)
New Revision: 1774

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/general/comm.tcl
   trunk/tkabber/tkabber-remote.tcl
Log:
	* plugins/general/comm.tcl, tkabber-remote.tcl: Made errors from a
	  remote Tkabber reported, and not showed in the Tkabber itself.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-04-01 15:41:51 UTC (rev 1773)
+++ trunk/tkabber/ChangeLog	2009-04-02 19:50:30 UTC (rev 1774)
@@ -1,3 +1,8 @@
+2009-04-02  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/general/comm.tcl, tkabber-remote.tcl: Made errors from a
+	  remote Tkabber reported, and not showed in the Tkabber itself.
+
 2009-04-01  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/comm.tcl, tkabber-remote.tcl: Added proof-of-concept

Modified: trunk/tkabber/plugins/general/comm.tcl
===================================================================
--- trunk/tkabber/plugins/general/comm.tcl	2009-04-01 15:41:51 UTC (rev 1773)
+++ trunk/tkabber/plugins/general/comm.tcl	2009-04-02 19:50:30 UTC (rev 1774)
@@ -68,6 +68,12 @@
     }
 }
 
+proc comm::eval_script {script} {
+    set status [catch {eval {uplevel #0} $script} res]
+
+    return [list $status $res]
+}
+
 proc comm::register_command {command proc arguments} {
     variable commands
 
@@ -80,13 +86,15 @@
     catch {unset commands($command)}
 }
 
-proc comm::eval_command {command args} {
+proc comm::eval_command {arglist} {
     variable commands
 
+    set arglist [lassign $arglist command]
     if {![info exists commands($command)]} {
-	return -code error [format "Command %s not found" $command]
+	return [list 1 [format "Command %s not found" $command]]
     } else {
-	eval [lindex $commands($command) 0] $args
+	set status [catch {eval {uplevel #0 [lindex $commands($command) 0]} $arglist} res]
+	return [list $status $res]
     }
 }
 

Modified: trunk/tkabber/tkabber-remote.tcl
===================================================================
--- trunk/tkabber/tkabber-remote.tcl	2009-04-01 15:41:51 UTC (rev 1773)
+++ trunk/tkabber/tkabber-remote.tcl	2009-04-02 19:50:30 UTC (rev 1774)
@@ -53,6 +53,7 @@
     puts $fid $cookie
 }
 
+set status 0
 foreach file $files {
     set fd [open $file]
     set id_cookie [read $fd]
@@ -62,9 +63,22 @@
     set cookie [lindex $id_cookie 1]
 
     if {$params(eval)} {
-	puts [eval [list ::comm::comm send $id] $argv]
+	set command ::plugins::comm::eval_script
     } else {
-	puts [eval [list ::comm::comm send $id] ::plugins::comm::eval_command $argv]
+	set command ::plugins::comm::eval_command
     }
+
+    set s [catch {::comm::comm send $id $command [list $argv]} res]
+    if {$s != 0} {
+	set res [list $s $res]
+    }
+
+    set status1 [lindex $res 0]
+    if {$status1 > $status} {
+	set status $status1
+    }
+    puts [lindex $res 1]
 }
 
+exit $status
+



More information about the Tkabber-dev mailing list